Load libraries
rm(list = ls())
currDir = getwd()
library(dplyr)
library(ggplot2)
library(emmeans)
library(lme4)
library(tidyr)
library(foreach)
library(ggsignif)
library(corrplot)
library(tidyverse)
library(ggcorrplot)
library(lsr)
library(ggpubr)
library(patchwork)
library(scales)
library(cowplot)
library(pdftools)
library(effectsize)
library(drc)
library(Mediana)
library(ggchicklet) #to make rounded rectangles in ggplot
library(ggdendro)
#library(DescTools)
source("get.agreement.metrices.R")
Setup plot theme
#Set text size and colors
txt.size = 14
txt.color = "black"
txt.face = "bold"
txt.font = "Arial"
#Define colors
colors <- data.frame(point.colors = c('#268072','#F37C2D','#F9C047', "#91b8af", "#fcb78f", "#f6e8d5"), label = c('u.color', 'i.color', 'j.color', 'u2.color', 'i2.color', 'j2.color'))
jitter.outline = "#f1f1f1"
outline.color = "#41424c"
legend.color = "#51535c"
legend2.color = "#9d9ea3"
#jitter for individual agreement values
jitter.alpha = .7
jitter.width = 0.3
jitter.size = 2
#point for mean agreement value
point.size = 5
point.alpha = 1
point.stroke = 1.4
point.shape = 21
#errorbar width
errorbar.width = .3
errorbar.alpha = 1
errorbar.size = 1.2
grain.labs <- c("Coarse", "Fine")
names(grain.labs) <- c("c", "f")
#Set theme for plotting
theme.esKnow <- theme(
panel.grid.minor = element_blank(),
panel.grid.major = element_blank(),
#panel.background= element_blank(),
panel.border = element_blank(),
panel.spacing = unit(.05,'in'),
panel.background = element_rect(fill = "transparent",colour = NA),
plot.background = element_rect(fill = "transparent",colour = NA),
axis.line = element_line(size = 0.5, colour = outline.color),
axis.title = element_text(size = txt.size, family = txt.font, color = txt.color, face = txt.face),
axis.text = element_text(size = txt.size, family = txt.font, color = txt.color, face = txt.face),
axis.title.y = element_text(margin = margin(t = 0, r = 10, b = 0, l = 0)),
axis.title.x = element_text(margin = margin(t = 10, r = 0, b = 0, l = 0)),
strip.background = element_rect(colour = NA, fill = "transparent"),
strip.text = element_text(size = txt.size, family = txt.font, color = txt.color, face = txt.face),
legend.title = element_blank(),
legend.key = element_rect(colour = NA, fill = NA),
plot.title = element_text(hjust = 0.5,size = txt.size, family = txt.font, color = txt.color, face = txt.face)
)
Load data and utils
setwd('../data/')
#segmentation data
esKnow1.segmentdata <- read.delim('esKnow_segmentdata.txt', head = TRUE)
esKnow1.clustering <- read.csv('esKnow_clustering_separated.csv', head = TRUE)
esKnow2.segmentdata <- read.delim("esKnow2_segmentdata.txt", head = TRUE)
esKnow2.lagCRP <- read.csv('esKnow2_lagCRP.csv', head = TRUE)
esKnow2.precision <- read.csv('esKnow2_precision.csv', head = TRUE)
esKnow2.recall <- read.csv('esKnow2_recallScores.csv', head = TRUE)
esKnow2.clustering <- read.csv('esKnow2_clustering.csv', head = TRUE)
esKnow2.recallTime <- read.csv('esKnow2_recallTime.csv', head = TRUE)
#list of pseudo index for recall coding of esKnow 2
esKnow2.pseudoIndex <- read.csv('esKnow2_pseudoIndex.csv', head = TRUE)
esKnow.eventTimeIndex <- read.csv('esKnow_eventTimeIndex.csv', head = TRUE)
iron.memorability <- read.csv('3Iron10Min_memorability.csv', head = TRUE)
corn.memorability <- read.csv('Corn10Min_memorability.csv', head = TRUE)
Select data for esKnow2 segmentation and rename movie to match movie naming of esKnow1
esKnow2.segmentdata <- esKnow2.segmentdata[esKnow2.segmentdata$movName != 'prac',] #exclude practice data
esKnow2.segmentdata$movName <- unlist(lapply(esKnow2.segmentdata$movName, function(x){
if(x == 'iron'){
return("3Iron")
} else {
return("Corn")
}
}))
Define factors and levels
grain.factor = c("c", "f")
condition.factor = c("Uninterrupted", "Interrupted", "Jumbled")
movie.factor = c("3Iron", "Corn")
##reorder factors
#segmentation data
esKnow1.segmentdata$grain <- factor(esKnow1.segmentdata$grain, levels = grain.factor)
esKnow1.segmentdata$condition <- factor(esKnow1.segmentdata$condition, levels = condition.factor)
esKnow1.segmentdata$movName <- factor(esKnow1.segmentdata$movName, levels = movie.factor)
esKnow1.segmentdata$grainorder <- factor(esKnow1.segmentdata$grainorder, levels = c(1,2)) #whether the segmentation data is from the 1st or 2nd round of segmentation
esKnow2.segmentdata$grain <- factor(esKnow2.segmentdata$grain, levels = grain.factor)
esKnow2.segmentdata$condition <- factor(esKnow2.segmentdata$condition, levels = condition.factor)
esKnow2.segmentdata$movName <- factor(esKnow2.segmentdata$movName, levels = movie.factor)
#recall data
esKnow1.clustering$condition <- factor(esKnow1.clustering$condition, levels = condition.factor)
esKnow1.clustering$movName <- factor(esKnow1.clustering$movName, levels = movie.factor)
esKnow2.clustering$condition <- factor(esKnow2.clustering$condition, levels = condition.factor)
esKnow2.clustering$movName <- factor(esKnow2.clustering$movName, levels = movie.factor)
esKnow2.lagCRP$condition <- factor(esKnow2.lagCRP$condition, levels = condition.factor)
esKnow2.lagCRP$movName <- factor(esKnow2.lagCRP$movName, levels = movie.factor)
esKnow2.precision$condition <- factor(esKnow2.precision$condition, levels = condition.factor)
esKnow2.precision$movName <- factor(esKnow2.precision$movName, levels = movie.factor)
esKnow2.recall$condition <- factor(esKnow2.recall$condition, levels = condition.factor)
esKnow2.recall$movName <- factor(esKnow2.recall$movName, levels = movie.factor)
esKnow2.recallTime$condition <- factor(esKnow2.recallTime$condition, levels = condition.factor)
esKnow2.recallTime$movName <- factor(esKnow2.recallTime$movName, levels = movie.factor)
Define some varible constants to use in analyses later on.
#movie duration
iron.mov.dur = 589 #seconds
corn.mov.dur = 566 #seconds
#for density estimations
bw = 'SJ'
c.adj = 0.1
f.adj = 0.05
dens.hz = 1
#for timeseries
bin.size = 1 #seconds
#for spectral density estimation
spect.adj = .01 #need to be low enough to pick up variation in segmentation pattern over time
del = 1
bw = 'SJ'
#to divide segmentation data per clip into n segments
esKnow1.nsegment <- 12 #divide each 1 minute clip to segments of 5s intervals
esKnow2.nsegment <- 5 #divide each 5 second clip to segments of 1s intervals
#list of separated fine event number (only applicable for esKnow1)
iron_separated <- c(10, 22, 30, 38, 43, 50, 58, 62, 67)
corn_separated <- c(7, 14, 21, 30, 37, 45, 52, 59, 65)
#total number of event units coded in recall
nEvents_iron_fine <- 74
nEvents_corn_fine <- 69
nEvents_iron_coarse <- 25
nEvents_corn_coarse <- 22
Check each participant’s number of button presses for coarse and fine grain segmentation
esKnow1.bp <- esKnow1.segmentdata %>% dplyr::group_by(condition, movName, grain, subid) %>%
dplyr::summarise(n.bp = length(bpTime.series)) %>% spread(grain, n.bp)
#investigate if there are participants who has more bp for coarse vs fine
esKnow1.bp[(esKnow1.bp$f - esKnow1.bp$c) < 0,]
## # A tibble: 2 × 5
## # Groups: condition, movName [1]
## condition movName subid c f
## <fct> <fct> <int> <int> <int>
## 1 Jumbled 3Iron 17 57 32
## 2 Jumbled 3Iron 23 10 6
#exclude participants with coarse bp > fine bp
esKnow1.segmentdata <- esKnow1.segmentdata %>% dplyr::filter(!(condition == unique(esKnow1.bp$condition[(esKnow1.bp$f - esKnow1.bp$c) < 0]) & subid %in% esKnow1.bp$subid[(esKnow1.bp$f - esKnow1.bp$c) < 0]))
Participants 23 and 17 from the Jumbled condition have more coarse bp than fine bp. This indicates that they may not have followed task instructions (fine segmentation should result in more button presses). So exclude these participants from the recall data too.
#exclude which segmentation data was excluded from recall analysis
esKnow1.clustering <- esKnow1.clustering %>% dplyr::filter(!(condition == "Jumbled" & exp_subid %in% c(23, 17)))
Calculate agreement index - comparing each individual to other individuals in the same condition - comparing each individual with other other individuals in different conditions
esKnow1.agreement.index <- data.frame()
for(cond in unique(esKnow1.round1$condition)){
for (segGrain in unique(esKnow1.round1$grain)){
for (movieName in unique(esKnow1.round1$movName)){
crossConds <- unique(esKnow1.round1$condition)[unique(esKnow1.round1$condition) != cond]
dat <- esKnow1.round1[esKnow1.round1$condition == cond & esKnow1.round1$grain == segGrain & esKnow1.round1$movName == movieName,]
crossdat <- esKnow1.round1[esKnow1.round1$condition != cond & esKnow1.round1$grain == segGrain & esKnow1.round1$movName == movieName,]
if(movieName == "3Iron"){
mov.dur = iron.mov.dur
} else {mov.dur = corn.mov.dur}
#define timeseries
timeseries <- seq(from = 1, to = mov.dur, by = bin.size)
for(sub in unique(dat$subid)){
grainorder <- unique(dat$grainorder[dat$subid == sub])
sub.ts <- as.numeric(timeseries %in% floor(dat$bpTime.series[dat$subid == sub]))
gp.timeseries <- unlist(tapply(dat$bpTime.series[dat$subid != sub], dat$subid[dat$subid!=sub], function(x){return(as.numeric(timeseries %in% floor(x)))}))
gp.ts <- tapply(gp.timeseries, rep(timeseries, length(unique(dat$subid))-1), mean)
#get random timeseries
random.timeseries <- unlist(tapply(gp.timeseries, rep(sample(length(unique(dat$subid))-1), each = length(timeseries)), sample))
random.ts <- tapply(random.timeseries, rep(timeseries, length(unique(dat$subid))-1), mean)
comparisons <- c(cond, "random")
agreements <- rbind(get.agreement.index(sub.ts, gp.ts), get.agreement.index(sub.ts, random.ts))
for(crossCond in crossConds){
crossgp.bp <- crossdat$bpTime.series[crossdat$condition == crossCond]
crossgp.timeseries <- unlist(tapply(crossgp.bp, crossdat$subid[crossdat$condition == crossCond], function(x){return(as.numeric(timeseries %in%floor(x)))}))
crossgp.ts <- tapply(crossgp.timeseries, rep(timeseries, length(unique(crossdat$subid[crossdat$condition == crossCond]))), mean)
comparisons <- c(comparisons, crossCond)
agreements <- rbind(agreements, get.agreement.index(sub.ts, crossgp.ts))
}
comp_types <- c("same", "random", "crossCond", "crossCond")
esKnow1.agreement.index <- rbind(esKnow1.agreement.index, data.frame(subid = rep(sub, length(comparisons)),
indiv_cond = factor(rep(cond, length(comparisons)), levels = condition.factor),
movName = factor(rep(movieName, length(comparisons)), levels = movie.factor),
grain = factor(rep(segGrain, length(comparisons)), levels = grain.factor),
group_cond = factor(comparisons, levels = c(condition.factor, "random")),
comparison_type = factor(comp_types),
grainorder = factor(rep(grainorder, length(comparisons)), levels = c(1,2)),
min_corr = agreements[,1],
max_corr = agreements[,2],
act_corr = agreements[,3],
agreementIndex = agreements[,4]))
}
}
}
}
If interrupting or jumbling videos influence segmentation pattern, we can expect that compared to agreement within uninterrupted group (i.e., uninterrupted individuals compared with uninterrupted group): Poorer agreement when interrupted or jumbled individuals are compared with uninterrupted group
Build and compare models
#test for (1)
esKnow.agreement.withU <- esKnow1.agreement.index %>% dplyr::filter(group_cond == "Uninterrupted") %>% droplevels()
esKnow.agreement.withU.lmer <- lmer(agreementIndex~indiv_cond*grain + movName + (1|subid), data = esKnow.agreement.withU)
esKnow.agreement.withU.lmer.B <- lmer(agreementIndex~indiv_cond*grain*movName + (1|subid), data = esKnow.agreement.withU)
anova(esKnow.agreement.withU.lmer, esKnow.agreement.withU.lmer.B)
## Data: esKnow.agreement.withU
## Models:
## esKnow.agreement.withU.lmer: agreementIndex ~ indiv_cond * grain + movName + (1 | subid)
## esKnow.agreement.withU.lmer.B: agreementIndex ~ indiv_cond * grain * movName + (1 | subid)
## npar AIC BIC logLik deviance Chisq Df
## esKnow.agreement.withU.lmer 9 -391.13 -362.00 204.56 -409.13
## esKnow.agreement.withU.lmer.B 14 -388.14 -342.83 208.07 -416.14 7.0092 5
## Pr(>Chisq)
## esKnow.agreement.withU.lmer
## esKnow.agreement.withU.lmer.B 0.22
Adding movie as interaction term did not improve model fit, use simpler model for subsequent analyses
Test for main and interaction effects
joint_tests(esKnow.agreement.withU.lmer)
## model term df1 df2 F.ratio p.value
## indiv_cond 2 157.72 0.737 0.4804
## grain 1 32.52 203.716 <.0001
## movName 1 148.27 4.880 0.0287
## indiv_cond:grain 2 157.72 4.127 0.0179
eta_squared(esKnow.agreement.withU.lmer)
## # Effect Size for ANOVA (Type III)
##
## Parameter | Eta2 (partial) | 90% CI
## ------------------------------------------------
## indiv_cond | 9.32e-03 | [0.00, 0.04]
## grain | 0.87 | [0.79, 0.91]
## movName | 0.03 | [0.00, 0.09]
## indiv_cond:grain | 0.05 | [0.00, 0.11]
There is no main effect of individual condition on agreement index, suggesting that when compared to Uninterrupted group, Interrupted and Jumbled individuals performed similarly to uninterrupted individuals (as measured by agreement index)
There is a significant conditionxgrain interaction.
Pairwise comparison to test for interaction effects
summary(emmeans(esKnow.agreement.withU.lmer.B, c("grain"),
contr = "revpairwise", weights = "proportional", adjust = "holm")$contrasts, infer = TRUE)
## contrast estimate SE df lower.CL upper.CL t.ratio p.value
## f - c 0.216 0.0152 32.5 0.185 0.247 14.206 <.0001
##
## Results are averaged over the levels of: indiv_cond, movName
## Degrees-of-freedom method: kenward-roger
## Confidence level used: 0.95
summary(emmeans(esKnow.agreement.withU.lmer.B, c("grain", "indiv_cond"),
contr = list(UvsI = c(-.5, .5, .5, -.5, 0,0),
UvsJ = c(-.5, .5, 0, 0, .5, -.5),
IvsJ = c(0, 0, -.5, .5, .5, -.5)), weights = "proportional", adjust = "holm")$contrasts, infer = TRUE)
## contrast estimate SE df lower.CL upper.CL t.ratio p.value
## UvsI 0.000931 0.0140 152 -0.0330 0.034906 0.066 0.9472
## UvsJ -0.035603 0.0144 156 -0.0703 -0.000864 -2.480 0.0346
## IvsJ -0.036534 0.0143 152 -0.0711 -0.001947 -2.557 0.0346
##
## Results are averaged over the levels of: movName
## Degrees-of-freedom method: kenward-roger
## Confidence level used: 0.95
## Conf-level adjustment: bonferroni method for 3 estimates
## P value adjustment: holm method for 3 tests
In all condition, agreement index with uninterrupted group for fine segmentation is higher than agreement index with uninterrupted group for coarse segmentation, however, difference between fine and coarse is more prominent for jumbled group.
Plot
esKnow1.agreementIndex_indivVSUgroup_plot <- ggplot(esKnow.agreement.withU, aes(x = indiv_cond, y = agreementIndex, fill = indiv_cond, color = indiv_cond))+
geom_jitter(width = jitter.width, alpha = jitter.alpha-.2, shape = point.shape, color = jitter.outline, size = jitter.size)+
stat_summary(geom = "errorbar", fun.data = "mean_cl_normal", width = errorbar.width +.15, color = outline.color, alpha = errorbar.alpha, size = errorbar.size)+
geom_point(stat = "summary", fun = "mean", size = point.size, shape = point.shape, color = outline.color, stroke = point.stroke, legend = FALSE)+
#geom_signif()+
scale_fill_manual(values = colors$point.colors, labels = NULL, guide = "none")+
scale_color_manual(values = colors$point.colors, labels = NULL, guide = "none")+
scale_x_discrete(labels=c("U", "I", "J"))+
facet_wrap(~grain, scales = "fixed", labeller = labeller(grain = c("c" = "Coarse", "f" = "Fine")))+
coord_cartesian(ylim=c(0, 1))+
labs(y = "Agreement Index", x = "Individual") +
theme.esKnow
esKnow1.agreementIndex_indivVSUgroup_plot
# setwd('../plots/')
# ggsave("esKnow1_agreement_indivVSUgroup.pdf", plot = esKnow1.agreementIndex_indivVSUgroup_plot, width = 6, height = 4, device = cairo_pdf)
# pdf_convert(pdf = "esKnow1_agreement_indivVSUgroup.pdf", format = "png", dpi = 300,
# filenames = "esKnow1_agreement_indivVSUgroup.png")
From analysis of agreement index, there seems to be minimal evidence for influence of interrupting or jumbling videos on segmentation pattern over time.
Consistent with the main analyses, adding discontinuity and incoherence in information flow minimally impacts overall segmentation. When information cannot be accumulated coherently over time, segmentation rate briefly increase but quickly stabilizes when information can be accumulated coherently beyond 5 seconds.
## Create figure for segmentation results from esKnow (Figure 2)
figS1_top <- ggarrange(esKnow1.bpRate_plot, esKnow1.agreementIndex_indivVSUgroup_plot,
widths = c(1, 1),
labels = c("A", "B"),
ncol = 2, nrow = 1)
figureS1 <- ggarrange(figS1_top, esKnow1.bp5sec.plot,
labels = c("", "C"),
ncol = 1, nrow = 2)
# fig2_top <- ggarrange(esKnow1.bpRate_plot, esKnow1.agreementIndex_indivVSUgroup_plot,
# labels = c("A", "B"), ncol = 2, nrow = 1)
# fig2_middle <- ggarrange(esKnow1.coarse.dens, esKnow1.fine.dens, ncol = 1, nrow = 2, common.legend = TRUE)
# figure2 <- ggarrange(fig2_top, fig2_middle, esKnow1.bp5sec.plot,
# heights = c(1,1.2, 1.2),
# labels = c('', 'C', 'D'),
# ncol = 1, nrow = 3)
figureS1
# setwd('../plots/')
# ggsave("esKnow1_figureS1.pdf", plot = figureS1, width = 9, height = 7, device = cairo_pdf)
# pdf_convert(pdf = "esKnow1_figureS1.pdf", format = "png", dpi = 300,
# filenames = "esKnow1_figureS1.png")
There’s significantly higher recall rate for separated events for 3Iron that is consistent across conditions. There may be something ‘special’ about these events. One potential is that scenes in separated events are somehow more memorable. Inspect memorability scores for separated vs intact events.
iron.memorability <- iron.memorability[iron.memorability$time <= iron.mov.dur,]
iron.memorability$fineEventNo <- 0
for(i in seq(1:nrow(iron.memorability))){
iron.memorability$fineEventNo[i] <- unique(esKnow.eventTimeIndex$fineEventNo[which(floor(esKnow.eventTimeIndex$startTime[esKnow.eventTimeIndex$movName == "3Iron"]) <= iron.memorability$time[i] & ceiling(esKnow.eventTimeIndex$endTime[esKnow.eventTimeIndex$movName == "3Iron"]) >= iron.memorability$time[i])])
}
iron.memorability$separated <- factor(iron.memorability$fineEventNo %in% iron_separated)
iron.memorability$movName <- "3Iron"
corn.memorability <- corn.memorability[corn.memorability$time <= corn.mov.dur,]
corn.memorability$fineEventNo <- 0
for(i in seq(1:nrow(corn.memorability))){
corn.memorability$fineEventNo[i] <- unique(esKnow.eventTimeIndex$fineEventNo[which(floor(esKnow.eventTimeIndex$startTime[esKnow.eventTimeIndex$movName == "Corn"]) <= corn.memorability$time[i] & ceiling(esKnow.eventTimeIndex$endTime[esKnow.eventTimeIndex$movName == "Corn"]) >= corn.memorability$time[i])])
}
corn.memorability$separated <- factor(corn.memorability$fineEventNo %in% corn_separated)
corn.memorability$movName <- "Corn"
allmov.memorability <- rbind(iron.memorability, corn.memorability)
esKnow1.eventMemo.ann <- data.frame(xstart = c(1), xend = c(2),
ystart = c(0.9), yend = c(0.9),
x = c(1.5), y = c(.925),
label = c("***"),
movName = c("3Iron"))
memo.lm.A <- lm(memorability~separated+movName, data = allmov.memorability)
memo.lm.B <- lm(memorability~separated*movName, data = allmov.memorability)
anova(memo.lm.A, memo.lm.B)
## Analysis of Variance Table
##
## Model 1: memorability ~ separated + movName
## Model 2: memorability ~ separated * movName
## Res.Df RSS Df Sum of Sq F Pr(>F)
## 1 1152 11.774
## 2 1151 11.662 1 0.11181 11.036 0.0009218 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
joint_tests(memo.lm.B)
## model term df1 df2 F.ratio p.value
## separated 1 1151 0.120 0.7286
## movName 1 1151 15.959 0.0001
## separated:movName 1 1151 11.036 0.0009
summary(emmeans(memo.lm.B, "separated", by = "movName", contr = "revpairwise", weights = "proportional", adjust = "holm")$contrasts, infer = TRUE)
## movName = 3Iron:
## contrast estimate SE df lower.CL upper.CL t.ratio p.value
## TRUE - FALSE 0.0338 0.0100 1151 0.0142 0.05352 3.375 0.0008
##
## movName = Corn:
## contrast estimate SE df lower.CL upper.CL t.ratio p.value
## TRUE - FALSE -0.0274 0.0155 1151 -0.0578 0.00294 -1.772 0.0766
##
## Confidence level used: 0.95
esKnow1.memo.plot <- ggplot(allmov.memorability, aes(separated, memorability, fill = separated, color = separated))+
geom_jitter(alpha = 0.3, position = position_jitterdodge(.7), size = jitter.size, shape = point.shape, color = jitter.outline)+
stat_summary(geom = "errorbar", fun.data = "mean_cl_normal", width = errorbar.width, color = outline.color, alpha = errorbar.alpha, position =position_dodge(0.5), size = 1) +
geom_point(stat = "summary", fun = "mean", size = point.size, shape = 21, color = outline.color, position = position_dodge(0.5), stroke = 1.2) +
scale_color_manual(values = c("#7aa6c2", "#004c6d"))+
scale_fill_manual(values = c("#7aa6c2", "#004c6d"))+
geom_segment(data = esKnow1.eventMemo.ann, aes(x = xstart, y = ystart, xend = xend, yend = yend), color = outline.color, size = 1, inherit.aes = FALSE) +
geom_text(data = esKnow1.eventMemo.ann, aes(x = x, y = y, label = label), color = outline.color, size = 8, inherit.aes = FALSE) +
facet_wrap(~movName)+
scale_x_discrete(name = "Event type", labels = c("Intact", "Separated"))+
labs(y = "Memorability", x = "Separated")+
coord_cartesian(ylim = c(0,1))+
theme(legend.position = "none")+
theme.esKnow
esKnow1.memo.plot
# setwd('../plots/')
# ggsave("esKnow1_eventMemo.pdf", plot = esKnow1.memo.plot, width = 6, height = 4, device = cairo_pdf)
# pdf_convert(pdf = "esKnow1_eventMemo.pdf", format = "png", dpi = 300,
# filenames = "esKnow1_eventMemo.png")
esKnow1.temporalClust.lmer <- lmer(temporal_clustering~condition*event_condition + movName + (1|exp_subid), data = esKnow1.clustering)
esKnow1.temporalClust.lmer.B <- lmer(temporal_clustering~condition*event_condition*movName + (1|exp_subid), data = esKnow1.clustering)
anova(esKnow1.temporalClust.lmer, esKnow1.temporalClust.lmer.B)
## Data: esKnow1.clustering
## Models:
## esKnow1.temporalClust.lmer: temporal_clustering ~ condition * event_condition + movName + (1 | exp_subid)
## esKnow1.temporalClust.lmer.B: temporal_clustering ~ condition * event_condition * movName + (1 | exp_subid)
## npar AIC BIC logLik deviance Chisq Df
## esKnow1.temporalClust.lmer 9 -535.23 -500.36 276.62 -553.23
## esKnow1.temporalClust.lmer.B 14 -559.90 -505.65 293.95 -587.90 34.665 5
## Pr(>Chisq)
## esKnow1.temporalClust.lmer
## esKnow1.temporalClust.lmer.B 1.755e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
joint_tests(esKnow1.temporalClust.lmer.B)
## model term df1 df2 F.ratio p.value
## condition 2 332.65 93.761 <.0001
## event_condition 1 311.94 1.795 0.1813
## movName 1 312.17 0.481 0.4883
## condition:event_condition 2 311.84 2.920 0.0554
## condition:movName 2 311.84 5.833 0.0033
## event_condition:movName 1 312.57 16.212 0.0001
## condition:event_condition:movName 2 311.61 5.144 0.0063
eta_squared(esKnow1.temporalClust.lmer.B, partial = TRUE)
## # Effect Size for ANOVA (Type III)
##
## Parameter | Eta2 (partial) | 90% CI
## -----------------------------------------------------------------
## condition | 0.36 | [0.30, 0.42]
## event_condition | 5.73e-03 | [0.00, 0.03]
## movName | 1.54e-03 | [0.00, 0.02]
## condition:event_condition | 0.02 | [0.00, 0.05]
## condition:movName | 0.04 | [0.01, 0.07]
## event_condition:movName | 0.05 | [0.02, 0.09]
## condition:event_condition:movName | 0.03 | [0.01, 0.07]
Examine if temporal clustering score is above chance
summary(emmeans(esKnow1.temporalClust.lmer.B, "condition"), null = 0.5, infer=TRUE)
## condition emmean SE df lower.CL upper.CL null t.ratio p.value
## Uninterrupted 0.908 0.0104 136 0.888 0.929 0.5 39.262 <.0001
## Interrupted 0.903 0.0105 137 0.882 0.924 0.5 38.348 <.0001
## Jumbled 0.738 0.0110 148 0.716 0.759 0.5 21.647 <.0001
##
## Results are averaged over the levels of: event_condition, movName
## Degrees-of-freedom method: kenward-roger
## Confidence level used: 0.95
summary(emmeans(esKnow1.temporalClust.lmer.B, "condition", weights = "proportional", contr = "pairwise")$contrasts, infer=TRUE)
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted 0.00486 0.0137 332 -0.0273 0.037 0.356
## Uninterrupted - Jumbled 0.17138 0.0140 335 0.1384 0.204 12.251
## Interrupted - Jumbled 0.16652 0.0141 333 0.1334 0.200 11.850
## p.value
## 0.9327
## <.0001
## <.0001
##
## Results are averaged over the levels of: event_condition, movName
## Degrees-of-freedom method: kenward-roger
## Confidence level used: 0.95
## Conf-level adjustment: tukey method for comparing a family of 3 estimates
## P value adjustment: tukey method for comparing a family of 3 estimates
summary(emmeans(esKnow1.temporalClust.lmer.B, c("condition", "event_condition"), by = "movName", contr = "pairwise", adjust = "holm")$contrasts, infer = TRUE)
## movName = 3Iron:
## contrast estimate SE df lower.CL
## Uninterrupted intact - Interrupted intact 0.01078 0.0265 316 -0.06749
## Uninterrupted intact - Jumbled intact 0.14647 0.0269 317 0.06685
## Uninterrupted intact - Uninterrupted separated 0.01544 0.0264 310 -0.06266
## Uninterrupted intact - Interrupted separated 0.02520 0.0269 317 -0.05443
## Uninterrupted intact - Jumbled separated 0.29760 0.0274 319 0.21646
## Interrupted intact - Jumbled intact 0.13569 0.0269 316 0.05612
## Interrupted intact - Uninterrupted separated 0.00466 0.0265 316 -0.07361
## Interrupted intact - Interrupted separated 0.01441 0.0269 312 -0.06504
## Interrupted intact - Jumbled separated 0.28681 0.0274 317 0.20573
## Jumbled intact - Uninterrupted separated -0.13103 0.0269 317 -0.21065
## Jumbled intact - Interrupted separated -0.12128 0.0274 317 -0.20218
## Jumbled intact - Jumbled separated 0.15112 0.0278 312 0.06897
## Uninterrupted separated - Interrupted separated 0.00975 0.0269 317 -0.06987
## Uninterrupted separated - Jumbled separated 0.28215 0.0274 319 0.20101
## Interrupted separated - Jumbled separated 0.27240 0.0279 319 0.19000
## upper.CL t.ratio p.value
## 0.0891 0.408 1.0000
## 0.2261 5.441 <.0001
## 0.0935 0.585 1.0000
## 0.1048 0.936 1.0000
## 0.3787 10.847 <.0001
## 0.2153 5.044 <.0001
## 0.0829 0.176 1.0000
## 0.0939 0.537 1.0000
## 0.3679 10.462 <.0001
## -0.0514 -4.867 <.0001
## -0.0404 -4.434 0.0001
## 0.2333 5.441 <.0001
## 0.0894 0.362 1.0000
## 0.3633 10.284 <.0001
## 0.3548 9.777 <.0001
##
## movName = Corn:
## contrast estimate SE df lower.CL
## Uninterrupted intact - Interrupted intact -0.00550 0.0269 317 -0.08512
## Uninterrupted intact - Jumbled intact 0.13380 0.0272 318 0.05344
## Uninterrupted intact - Uninterrupted separated -0.02863 0.0274 313 -0.10959
## Uninterrupted intact - Interrupted separated -0.02447 0.0272 318 -0.10483
## Uninterrupted intact - Jumbled separated 0.09078 0.0287 320 0.00603
## Interrupted intact - Jumbled intact 0.13930 0.0276 318 0.05767
## Interrupted intact - Uninterrupted separated -0.02313 0.0279 320 -0.10559
## Interrupted intact - Interrupted separated -0.01897 0.0275 311 -0.10036
## Interrupted intact - Jumbled separated 0.09627 0.0291 320 0.01032
## Jumbled intact - Uninterrupted separated -0.16244 0.0281 321 -0.24562
## Jumbled intact - Interrupted separated -0.15827 0.0278 319 -0.24062
## Jumbled intact - Jumbled separated -0.04303 0.0292 315 -0.12941
## Uninterrupted separated - Interrupted separated 0.00416 0.0281 321 -0.07901
## Uninterrupted separated - Jumbled separated 0.11941 0.0296 322 0.03201
## Interrupted separated - Jumbled separated 0.11524 0.0293 321 0.02859
## upper.CL t.ratio p.value
## 0.0741 -0.204 1.0000
## 0.2142 4.924 <.0001
## 0.0523 -1.046 1.0000
## 0.0559 -0.901 1.0000
## 0.1755 3.168 0.0135
## 0.2209 5.047 <.0001
## 0.0593 -0.830 1.0000
## 0.0624 -0.689 1.0000
## 0.1822 3.312 0.0093
## -0.0793 -5.775 <.0001
## -0.0759 -5.684 <.0001
## 0.0434 -1.473 0.9916
## 0.0873 0.148 1.0000
## 0.2068 4.040 0.0007
## 0.2019 3.933 0.0010
##
## Degrees-of-freedom method: kenward-roger
## Confidence level used: 0.95
## Conf-level adjustment: bonferroni method for 15 estimates
## P value adjustment: holm method for 15 tests
esKnow1.clustering$event_condition <- factor(esKnow1.clustering$event_condition, levels = c("intact", 'separated'))
esKnow1.temporalClustering_plot <- ggplot(esKnow1.clustering, aes(x = condition, y = temporal_clustering, fill = interaction(condition, event_condition), color = interaction(condition, event_condition)))+
geom_jitter(alpha = jitter.alpha-.2, position = position_jitterdodge(1.2), size = jitter.size, shape = point.shape, color = jitter.outline)+
stat_summary(geom = "errorbar", fun.data = "mean_cl_normal", width = 0.3, color = outline.color, alpha = errorbar.alpha, position =position_dodge(0.5), size = 1.2) +
geom_point(stat = "summary", fun = "mean", size = point.size, shape = 21, color = outline.color, position = position_dodge(0.5), stroke = 1.2) +
scale_fill_manual(values = colors$point.colors)+
scale_color_manual(values = colors$point.colors)+
scale_x_discrete(labels=c("Uninterrupted" = "U", "Interrupted" = "I",
"Jumbled" = "J"))+
geom_segment(aes(x = 2, y = 1.05, xend = 3, yend = 1.05), color = outline.color, size = 1) +
#geom_segment(aes(x = 2, y = 1.05, xend = 2, yend = 1), color = outline.color, size = 1) +
#geom_segment(aes(x = 3, y = 1.05, xend = 3, yend = 1), color = outline.color, size = 1) +
annotate("text", x = 2.5, y = 1.08, label = "***", color = outline.color, size = 8, fontface = txt.face) +
geom_segment(aes(x = 1, y = 1.2, xend = 3, yend = 1.2), color = outline.color, size = 1) +
#geom_segment(aes(x = 1, y = 1.2, xend = 1, yend = 1.15), color = outline.color, size = 1) +
#geom_segment(aes(x = 3, y = 1.2, xend = 3, yend = 1.15), color = outline.color, size = 1) +
annotate("text", x = 2, y = 1.23, label = "***", color = outline.color, size = 8, fontface = txt.face) +
coord_cartesian(ylim = c(0,1.25))+
scale_y_continuous(breaks = c(0, 0.5, 1), labels = c('0.0', '0.5', '1.0'))+
labs(title = "", x = "", y = "Temporal Clustering")+
theme(legend.position = 'none') +
theme.esKnow
esKnow1.temporalClustering_plot
# setwd('../plots_transparentBG/')
# ggsave("esKnow1_tempotalClustering.png", plot = esKnow1.temporalClustering_plot, width = 4, height = 4, bg = "transparent")
# setwd('../plots/')
# ggsave("esKnow1_figureS3.pdf", plot = esKnow1.temporalClustering_plot, width = 6, height = 4, device = cairo_pdf)
# pdf_convert(pdf = "esKnow1_figureS3.pdf", format = "png", dpi = 300,
# filenames = "esKnow1_figureS3.png")
Clean data for esKnow 2
esKnow.combined.bpTime <- rbind(esKnow1.segmentdata %>% dplyr::select(subid, grain, movName, bpTime.series, condition) %>% dplyr::mutate(exp = factor("esKnow1")), esKnow2.segmentdata %>% dplyr::select(subid, grain, movName, bpTime.series, condition) %>% dplyr::mutate(exp = factor("esKnow2")))
peakiness <- data.frame()
for(movieName in unique(esKnow.combined.bpTime$movName)){
for(segGrain in unique(esKnow.combined.bpTime$grain)){
for(expNo in unique(esKnow.combined.bpTime$exp)){
for(cond in unique(esKnow.combined.bpTime$condition)){
if(movieName == "3Iron"){mov.dur = iron.mov.dur}else{mov.dur = corn.mov.dur}
if(segGrain == "c"){adj.size = c.adj}else{adj.size = f.adj}
dat <- esKnow.combined.bpTime %>% dplyr::filter(movName == movieName, grain == segGrain, exp == expNo, condition == cond)
pk <- get.peakiness(dat$bpTime.series, mov.dur, dat$subid, adj.size)
peakiness <- rbind(peakiness, data.frame(exp = expNo, movName = movieName, grain = segGrain, condition = cond, min_rugo = pk[1], act.rugo = pk[2], peakiness = pk[3]))
}
}
}
}
Calculate random peakiness for esKnow 1
# n.iter = 1000
# random.peakiness <- data.frame()
#
# for (i in seq(1,n.iter,1)){
# for (movieName in unique(esKnow1.segmentdata$movName)){
# if(movieName == "3Iron"){
# mov.dur = iron.mov.dur
# }else{
# mov.dur = corn.mov.dur
# }
# dat <- esKnow1.segmentdata[esKnow1.segmentdata$movName == movieName,]
# rand.bp <- data.frame(subid = dat$subid,
# condition = dat$condition,
# grain = dat$grain,
# movName = movieName,
# iteration = i,
# bpTime.series = unlist(tapply(dat$bpTime.series, list(dat$subid,
# dat$condition,
# dat$grain),
# function(x){
# runif(length(x), min = 0, max = mov.dur)
# })))
# for (grain in unique(rand.bp$grain)){
# if(grain == 'c'){
# adj.size = .1
# } else {
# adj.size = .05
# }
# dat.grain <- rand.bp[rand.bp$grain == grain,]
# random.peakiness <- rbind(random.peakiness, dat.grain %>% dplyr::group_by(condition, grain, movName, iteration) %>% dplyr::summarise(pk = get.peakiness(bpTime.series, mov.dur, subid, adj.size)) %>% mutate(type = c('min_peakiness', 'max_peakiness', 'peakiness')) %>% spread(type, pk))
# }
# }
# }
#
# #save
# write.csv(random.peakiness, "../data/esKnow1_randomPeakiness.csv", row.names = FALSE)
#Load saved peakiness derived from randomly sampling segmentation data 1000 times
random.peakiness <- read.csv("../data/esKnow1_randomPeakiness.csv", head = TRUE)
#calculate 95% CI for each values
peakiness.CI <- random.peakiness %>% dplyr::group_by(condition, movName, grain) %>% dplyr::summarise(mean = mean(peakiness),CI = quantile(peakiness, probs= c(.025, .975))) %>% dplyr::mutate(level = c("lower", "upper")) %>% spread(level, CI)
# n.iter = 1000
# random.peakiness.esKnow2 <- data.frame()
#
# for (i in seq(1,n.iter,1)){
# #print(i)
# for (movieName in unique(esKnow2.segmentdata$movName)){
# if(movieName == "3Iron"){
# mov.dur = iron.mov.dur
# }else{
# mov.dur = corn.mov.dur
# }
# dat <- esKnow2.segmentdata[esKnow2.segmentdata$movName == movieName,]
# rand.bp <- data.frame(subid = dat$subid,
# condition = dat$condition,
# grain = dat$grain,
# movName = movieName,
# iteration = i,
# bpTime.series = unlist(tapply(dat$bpTime.series, list(dat$subid,
# dat$condition,
# dat$grain),
# function(x){
# runif(length(x), min = 0, max = mov.dur)
# })))
# for (grain in unique(rand.bp$grain)){
# if(grain == 'c'){
# adj.size = .1
# } else {
# adj.size = .05
# }
# dat.grain <- rand.bp[rand.bp$grain == grain,]
# random.peakiness.esKnow2 <- rbind(random.peakiness.esKnow2, dat.grain %>% dplyr::group_by(condition, grain, movName, iteration) %>% dplyr::summarise(pk = get.peakiness(bpTime.series, mov.dur, subid, adj.size)) %>% mutate(type = c('min_peakiness', 'max_peakiness', 'peakiness')) %>% spread(type, pk))
# }
# }
# }
# #save
# write.csv(random.peakiness.esKnow2, "../data/esKnow2_randomPeakiness.csv", row.names = FALSE)
#Load saved peakiness derived from randomly sampling segmentation data 1000 times
random.peakiness.esKnow2 <- read.csv("../data/esKnow2_randomPeakiness.csv", head = TRUE)
#calculate 95% CI for each values
peakiness.CI.esKnow2 <- random.peakiness.esKnow2 %>% dplyr::group_by(condition, movName, grain) %>% dplyr::summarise(mean = mean(peakiness),CI = quantile(peakiness, probs= c(.025, .975))) %>% dplyr::mutate(level = c("lower", "upper")) %>% spread(level, CI)
#combine random peakiness from esKnow1 and 2
peakiness.CI$exp <- "esKnow1"
peakiness.CI.esKnow2$exp <- "esKnow2"
peakiness.CI.combined <- rbind(peakiness.CI, peakiness.CI.esKnow2)
peakiness.CI.combined$exp <- factor(peakiness.CI.combined$exp, level = c("esKnow1", "esKnow2"))
esKnow2.peakiness <- ggplot(peakiness.CI.esKnow2, aes(x = condition, y = mean, color = condition, fill = condition,exp))+
geom_errorbar(aes(ymin = lower, ymax = upper), color = outline.color, width = errorbar.width, position=position_dodge(0.5), size = errorbar.size)+
geom_point(size = point.size, shape = point.shape, color = outline.color, stroke = point.stroke, legend = FALSE, position = position_dodge(0.5))+
geom_point(data = peakiness[peakiness$exp == "esKnow2",], aes(x = condition, y = peakiness, color = condition), position = position_dodge(0.5), shape = 23, size = point.size, stroke = point.stroke)+
scale_fill_manual(values = colors$point.colors, labels = NULL, guide = "none")+
scale_color_manual(values = colors$point.colors[4:6], labels = NULL, guide = "none")+
scale_x_discrete(labels=c("U", "I", "J"))+
facet_grid(movName~grain, scales = "fixed", labeller = labeller(grain = c("c" = "Coarse", "f" = "Fine"),
movName = c("3Iron" = "3Iron", "Corn" = "Corn")))+
coord_cartesian(ylim = c(0, 11))+
labs(y = "Peakiness", x = "", caption = "Individual diamonds = random peakiness")+
theme.esKnow
esKnow2.peakiness
# setwd('../plots/')
# ggsave("esKnow12_Peakiness_figureS4.pdf", plot = esKnow2.peakiness, width = 6, height = 4, device = cairo_pdf)
# pdf_convert(pdf = "esKnow12_Peakiness_figureS4.pdf", format = "png", dpi = 300,
# filenames = "esKnow12_Peakiness_figureS4.png")
Peakiness for uninterrupted group’s coarse segmentation in esKnow2 seems to overlap with random peakiness.
Compare agreement index across experiments
crossExp.agreement.index <- data.frame()
experiments = c("esKnow1.segmentdata", "esKnow2.segmentdata")
for(exp in experiments){
data <- get(exp)
crossData <- get(experiments[experiments!= exp])
for(cond in unique(esKnow2.segmentdata$condition)){
for (segGrain in unique(esKnow2.segmentdata$grain)){
for (movieName in unique(esKnow2.segmentdata$movName)){
dat <- data[data$condition == cond & data$grain == segGrain & data$movName == movieName,]
crossdat <- crossData[crossData$condition == cond & crossData$grain == segGrain & crossData$movName == movieName,]
if(movieName == "3Iron"){
mov.dur = iron.mov.dur
} else {mov.dur = corn.mov.dur}
#define timeseries
timeseries <- seq(from = 1, to = mov.dur, by = bin.size)
for(sub in unique(dat$subid)){
sub.ts <- as.numeric(timeseries %in% floor(dat$bpTime.series[dat$subid == sub]))
gp.timeseries <- unlist(tapply(dat$bpTime.series[dat$subid != sub], dat$subid[dat$subid!=sub], function(x){return(as.numeric(timeseries %in% floor(x)))}))
gp.ts <- tapply(gp.timeseries, rep(timeseries, length(unique(dat$subid))-1), mean)
crossgp.timeseries <- unlist(tapply(crossdat$bpTime.series, crossdat$subid, function(x){return(as.numeric(timeseries %in% floor(x)))}))
crossgp.ts <- tapply(crossgp.timeseries, rep(timeseries, length(unique(crossdat$subid))), mean)
comparisons <- c(substr(exp, 1,7), substr(experiments[experiments!=exp], 1,7))
agreements <- rbind(get.agreement.index(sub.ts, gp.ts), get.agreement.index(sub.ts, crossgp.ts))
crossExp.agreement.index <- rbind(crossExp.agreement.index, data.frame(subid = rep(sub, length(comparisons)),
condition = factor(rep(cond, length(comparisons)), levels = condition.factor),
movName = factor(rep(movieName, length(comparisons)), levels = movie.factor),
grain = factor(rep(segGrain, length(comparisons)), levels = grain.factor),
exp = factor(substr(exp, 1, 7), levels = c("esKnow1", "esKnow2")),
testExp = factor(comparisons, levels = c("esKnow1", "esKnow2")),
testType = factor(c("same", "different"), levels = c("same", "different")),
min_corr = agreements[,1],
max_corr = agreements[,2],
act_corr = agreements[,3],
agreementIndex = agreements[,4]))
}
}
}
}
}
crossExp.colors = c(colors$point.colors[1], colors$point.colors[2], colors$point.colors[3], colors$point.colors[1],
colors$point.colors[2], colors$point.colors[3], colors$point.colors[4], colors$point.colors[5],
colors$point.colors[6], colors$point.colors[4], colors$point.colors[5], colors$point.colors[6])
crossExp.agreement_plot <- ggplot(crossExp.agreement.index[crossExp.agreement.index$testType == "same",], aes(x = condition, y = agreementIndex, fill = interaction(condition, exp), color = interaction(condition,exp)))+
geom_jitter(alpha = jitter.alpha, position = position_jitterdodge(.8), size = jitter.size, shape = point.shape, color = jitter.outline)+
stat_summary(geom = "errorbar", fun.data = "mean_cl_normal", width = errorbar.width + .2, color = outline.color, alpha = errorbar.alpha, position =position_dodge(0.6), size = 1) +
geom_point(stat = "summary", fun = "mean", size = point.size-1, shape = 21, color = outline.color, position = position_dodge(0.6), stroke = 1.2)+
#geom_signif()+
scale_fill_manual(values = colors$point.colors, labels = NULL, guide = "none")+
scale_color_manual(values = colors$point.colors, labels = NULL, guide = "none")+
scale_x_discrete(labels=c("U", "I", "J"))+
scale_y_continuous(breaks = c(0, .5, 1), labels = c("0.0", '0.5', '1.0'))+
facet_grid(~grain, scales = "fixed", labeller = labeller(grain = c("c" = "Coarse", "f" = "Fine")))+
coord_cartesian(ylim=c(0, 1))+
labs(y = "Agreement index", x = "", caption = "Dark color = esKnow1, Light color = esKnow2") +
theme.esKnow
crossExp.agreement_plot
setwd('../plots/')
# ggsave("esKnow2_crossExpAgreement_figureS4.pdf", plot = crossExp.agreement_plot, width = 6, height = 4, device = cairo_pdf)
# pdf_convert(pdf = "esKnow2_crossExpAgreement_figureS4.pdf", format = "png", dpi = 300,
# filenames = "esKnow2_crossExpAgreement_figureS4.png")
crossExp.lmer <- lmer(agreementIndex~exp*grain*condition + movName + (condition|subid), data = crossExp.agreement.index[crossExp.agreement.index$testType == 'same',])
joint_tests(crossExp.lmer)
## model term df1 df2 F.ratio p.value
## exp 1 250.48 41.486 <.0001
## grain 1 447.77 521.670 <.0001
## condition 2 74.45 13.783 <.0001
## movName 1 408.05 0.099 0.7535
## exp:grain 1 447.77 13.002 0.0003
## exp:condition 2 137.83 9.802 0.0001
## grain:condition 2 298.49 5.522 0.0044
## exp:grain:condition 2 298.49 5.245 0.0058
eta_squared(crossExp.lmer)
## # Effect Size for ANOVA (Type III)
##
## Parameter | Eta2 (partial) | 90% CI
## ---------------------------------------------------
## exp | 0.14 | [0.08, 0.20]
## grain | 0.54 | [0.49, 0.58]
## condition | 0.28 | [0.14, 0.41]
## movName | 2.44e-04 | [0.00, 0.01]
## exp:grain | 0.03 | [0.01, 0.06]
## exp:condition | 0.10 | [0.04, 0.16]
## grain:condition | 0.03 | [0.01, 0.07]
## exp:grain:condition | 0.03 | [0.01, 0.07]
summary(emmeans(crossExp.lmer, "exp", contr = "pairwise", weights = "proportional", adjust = "holm")$contrast, infer = TRUE)
## contrast estimate SE df lower.CL upper.CL t.ratio p.value
## esKnow1 - esKnow2 0.0603 0.00933 244 0.0419 0.0787 6.465 <.0001
##
## Results are averaged over the levels of: grain, condition, movName
## Degrees-of-freedom method: kenward-roger
## Confidence level used: 0.95
summary(emmeans(crossExp.lmer, "exp", by = c("condition", "grain"), contr = "pairwise", weights = "proportional", adjust = "holm")$contrast, infer = TRUE)
## condition = Uninterrupted, grain = c:
## contrast estimate SE df lower.CL upper.CL t.ratio p.value
## esKnow1 - esKnow2 0.19632 0.0253 89.1 0.146059 0.2466 7.761 <.0001
##
## condition = Interrupted, grain = c:
## contrast estimate SE df lower.CL upper.CL t.ratio p.value
## esKnow1 - esKnow2 0.05527 0.0200 303.7 0.015990 0.0945 2.769 0.0060
##
## condition = Jumbled, grain = c:
## contrast estimate SE df lower.CL upper.CL t.ratio p.value
## esKnow1 - esKnow2 0.02459 0.0228 303.7 -0.020238 0.0694 1.079 0.2813
##
## condition = Uninterrupted, grain = f:
## contrast estimate SE df lower.CL upper.CL t.ratio p.value
## esKnow1 - esKnow2 0.04852 0.0248 89.1 -0.000668 0.0977 1.960 0.0531
##
## condition = Interrupted, grain = f:
## contrast estimate SE df lower.CL upper.CL t.ratio p.value
## esKnow1 - esKnow2 0.02841 0.0200 302.8 -0.010866 0.0677 1.423 0.1556
##
## condition = Jumbled, grain = f:
## contrast estimate SE df lower.CL upper.CL t.ratio p.value
## esKnow1 - esKnow2 0.00747 0.0210 337.0 -0.033911 0.0488 0.355 0.7229
##
## Results are averaged over the levels of: movName
## Degrees-of-freedom method: kenward-roger
## Confidence level used: 0.95
Peakiness suggest that segmentation performance for Uninterrupted is comparable across experiments.
Segmentation data for esKnow2 Uninterrupted coarse segmentation does not seem to be better than random performance. So we’ll use Uninterrupted data from exp 1 to evaluate esKnow2 Interrupted and Jumbled performance
Switch Uninterrupted data of esKnow2.segmentdata with esKnow 1
esKnow2.segmentdata <- esKnow2.segmentdata %>% dplyr::filter(condition != "Uninterrupted")
esKnow2.segmentdata <- rbind(esKnow2.segmentdata, esKnow1.segmentdata[esKnow1.segmentdata$condition == "Uninterrupted" & esKnow1.segmentdata$grainorder == 1,] %>% dplyr::select(subid, condition, grain, movName, clipNo, bpTime.series))
#calculate button press rate for esKnow 2
esKnow2.bp <- esKnow2.segmentdata %>% dplyr::group_by(condition, movName, grain, subid) %>%
dplyr::summarise(n.bp = length(bpTime.series))
#Calculate the rate of button press per minute for each movie
for (i in 1:nrow(esKnow2.bp)){
if(esKnow2.bp$movName[i] == "3Iron"){
esKnow2.bp$bpRate[i] <- esKnow2.bp$n.bp[i]/(iron.mov.dur/60)
} else if (esKnow2.bp$movName[i] == "Corn"){
esKnow2.bp$bpRate[i] <- esKnow2.bp$n.bp[i]/(corn.mov.dur/60)
}
}
esKnow2.bpRate.lmer <- lmer(bpRate~condition*grain + movName + (1|subid), data = esKnow2.bp)
esKnow2.bpRate.lmer.B <- lmer(bpRate~condition*grain*movName + (1|subid), data = esKnow2.bp)
anova(esKnow2.bpRate.lmer, esKnow2.bpRate.lmer.B)
## Data: esKnow2.bp
## Models:
## esKnow2.bpRate.lmer: bpRate ~ condition * grain + movName + (1 | subid)
## esKnow2.bpRate.lmer.B: bpRate ~ condition * grain * movName + (1 | subid)
## npar AIC BIC logLik deviance Chisq Df Pr(>Chisq)
## esKnow2.bpRate.lmer 9 1044.5 1073.7 -513.22 1026.5
## esKnow2.bpRate.lmer.B 14 1053.2 1098.7 -512.62 1025.2 1.2114 5 0.9438
joint_tests(esKnow2.bpRate.lmer)
## model term df1 df2 F.ratio p.value
## condition 2 158.76 31.178 <.0001
## grain 1 157.90 140.415 <.0001
## movName 1 122.66 1.715 0.1928
## condition:grain 2 151.18 2.443 0.0903
eta_squared(esKnow2.bpRate.lmer, partial = TRUE)
## # Effect Size for ANOVA (Type III)
##
## Parameter | Eta2 (partial) | 90% CI
## -----------------------------------------------
## condition | 0.40 | [0.27, 0.50]
## grain | 0.48 | [0.39, 0.56]
## movName | 0.01 | [0.00, 0.07]
## condition:grain | 0.03 | [0.00, 0.08]
Adding grain and movie name as interaction terms did not improve model fit, so use the simpler model.
summary(emmeans(esKnow2.bpRate.lmer, "condition", by = c("grain"), contr = "pairwise", weights = "proportional", adjust = "holm")$contrasts, infer = TRUE)
## grain = c:
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted 0.0549 0.816 154 -1.92 2.029 0.067
## Uninterrupted - Jumbled -3.6490 1.250 114 -6.69 -0.613 -2.920
## Interrupted - Jumbled -3.7039 1.282 110 -6.82 -0.588 -2.890
## p.value
## 0.9464
## 0.0127
## 0.0127
##
## grain = f:
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted -1.3245 1.216 110 -4.28 1.632 -1.089
## Uninterrupted - Jumbled -7.1983 0.839 163 -9.23 -5.168 -8.576
## Interrupted - Jumbled -5.8738 1.234 104 -8.88 -2.871 -4.760
## p.value
## 0.2785
## <.0001
## <.0001
##
## Results are averaged over the levels of: movName
## Degrees-of-freedom method: kenward-roger
## Confidence level used: 0.95
## Conf-level adjustment: bonferroni method for 3 estimates
## P value adjustment: holm method for 3 tests
#create dataframes to plot line segments and annotations
# esKnow2.bpRate_plot_ann <- data.frame(xstart = c(1,2,1,2), xend = c(3,3,3,3),
# ystart = c(33,29,33,29), yend = c(33,29,33,29),
# x = c(2,2.5,2,2.5), y = c(33.7, 29.7, 33.7, 29.7),
# label = c("*", "*", "***", "***"),
# grain = c("c", "c", "f", "f"))
#Legend if using esKnow2 data
esKnow2.bpRate_plot_ann <- data.frame(xstart = c(1,2), xend = c(3,3),
ystart = c(33,29), yend = c(33,29),
x = c(2,2.5), y = c( 33.7, 29.7),
label = c("***", "***"),
grain = c("f", "f"))
esKnow2.bpRate_plot <- ggplot(esKnow2.bp, aes(x = condition, y = bpRate, fill = condition, color = condition))+
geom_jitter(width = jitter.width, alpha = jitter.alpha - .2, shape = point.shape, color = jitter.outline, size = jitter.size)+
stat_summary(geom = "errorbar", fun.data = "mean_cl_normal", width = errorbar.width+.2, color = outline.color, alpha = errorbar.alpha, size = errorbar.size)+
geom_point(stat = "summary", fun = "mean", size = point.size-1, shape = point.shape, color = outline.color, stroke = point.stroke, legend = FALSE)+
#geom_signif()+
scale_fill_manual(values = colors$point.colors, labels = NULL, guide = "none")+
scale_color_manual(values = colors$point.colors, labels = NULL, guide = "none")+
scale_x_discrete(labels=c("U\n(Exp1)", "I", "J"))+ #"U\n(Exp1)"
geom_segment(data = esKnow2.bpRate_plot_ann, aes(x = xstart, y = ystart, xend = xend, yend = yend), inherit.aes = FALSE, color = outline.color, size = 1) +
geom_text(data = esKnow2.bpRate_plot_ann, aes(x = x, y = y, label = label), inherit.aes = FALSE, color = outline.color, size = 8, fontface = txt.face) +
facet_wrap(~grain, scales = "fixed", labeller = labeller(grain = c("c" = "Coarse", "f" = "Fine")))+
coord_cartesian(ylim=c(0, 40))+
labs(y = "Button press per minute", x = "") +
theme.esKnow
esKnow2.bpRate_plot
Higher button press rates for fine segmentation in Jumbled
condition.
Hierarchical organization of events Because segmentation grain was a between group manipulation, hierarchical agreement would need to be examined by making group level comparison. Using Khena’s approach for hierarchical organization action within goal changes, each coarse grain segmentation will be compared to the normative fine boundaries.
Function to get normative boundaries
get.normativeBounds <- function(sample, sub, mov.dur, adj.size, bw = 'SJ', dens.hz = 1){
#create temporary density distribution to get bandwidth of sample1 density distribution
temp <- density(sample, bw = bw, adjust = adj.size, kernel = 'g', n = ceiling(mov.dur*dens.hz), from = 1/dens.hz, to = mov.dur)
#add padding to time series
pad.ts <- ceiling(temp$bw * 2)
sample.dens <- density(sample, bw = bw, adjust = adj.size, kernel = 'g', n = ceiling((mov.dur+2*pad.ts)*dens.hz), from = 1/dens.hz - pad.ts, to = mov.dur + pad.ts)
#put values into dataframe for easy access
sample.dens.df <- data.frame("Time" = sample.dens$x, "Density" = sample.dens$y, "peak" = 0)
#Determine peaks and troughs for the density distribution.
#Peak = when density at time t is higher than density at t-1 and t+1.
#Trough = when density at t is lower than density at t-1 and t+1.
for (row in seq(from = 2, to = nrow(sample.dens.df)-1, by = 1)){
if (sample.dens.df$Density[row] > sample.dens.df$Density[row+1] && sample.dens.df$Density[row] > sample.dens.df$Density[row-1]){
sample.dens.df$peak[row] <- 1}
else if (sample.dens.df$Density[row] < sample.dens.df$Density[row+1] && sample.dens.df$Density[row] < sample.dens.df$Density[row-1]){
sample.dens.df$peak[row] <- -1}
}
##get all peaks
sample.peakTimes <- sample.dens.df$Time[sample.dens.df$peak == 1]
##calculate the number of normative boundaries (minimum of c(ave number of bp sample1, sample1 number of peaks, sample2 number of peaks))
n.norm.bp <- min(c(round(mean(tapply(sample, sub, length))), length(sample.peakTimes)))
#Obtain times when peak occurs
#Peak times then sorted in ascending order.
sample.normativeTimes <- sort(head(sample.dens.df[order(-sample.dens.df$peak, -sample.dens.df$Density),],n.norm.bp)$Time)
return(sample.normativeTimes)
}
esKnow2.alignment = data.frame()
for(movie in unique(esKnow2.segmentdata$movName)){
if(movie == '3Iron'){
mov.dur = iron.mov.dur
}else{
mov.dur = corn.mov.dur
}
for(cond in unique(esKnow2.segmentdata$condition)){
coarse.data <- esKnow2.segmentdata[esKnow2.segmentdata$condition == cond & esKnow2.segmentdata$grain == 'c' & esKnow2.segmentdata$movName == movie,]
fine.data <- esKnow2.segmentdata[esKnow2.segmentdata$condition == cond & esKnow2.segmentdata$grain == 'f' & esKnow2.segmentdata$movName == movie,]
norm_fine_bounds <- get.normativeBounds(fine.data$bpTime.series, fine.data$subid, mov.dur, 0.05)
get.alignment <- function(id){
coarse.bp <- sort(coarse.data$bpTime.series[coarse.data$subid == id])
fine.bp <- norm_fine_bounds
nearest.fine <- do.call(rbind, foreach(i = coarse.bp) %do% fine.bp[which.min(abs(i-fine.bp))])
nearest.fine.sign <- sign(coarse.bp - nearest.fine)
##alignment
nearest.null <- (diff(fine.bp)/2)^2
Ave.Dist <- mean(abs(coarse.bp - nearest.fine))
Ave.Dist.null <- ((fine.bp[1]^2)/2 + sum(nearest.null))/fine.bp[length(fine.bp)]
alignment.value = Ave.Dist.null - Ave.Dist
return(data.frame(subid = id, movName = factor(movie, levels = movie.factor), condition = factor(cond, levels = condition.factor), alignment = alignment.value, enclosure = mean((nearest.fine.sign)+1)/2))
}
esKnow2.alignment <- rbind(esKnow2.alignment, do.call(rbind, lapply(unique(coarse.data$subid), get.alignment)))
}
}
esKnow2.alignment.lmer <- lmer(alignment~condition + movName + (1|subid), data = esKnow2.alignment)
esKnow2.alignment.lmer.B <- lmer(alignment~condition*movName + (1|subid), data = esKnow2.alignment)
anova(esKnow2.alignment.lmer, esKnow2.alignment.lmer.B)
## Data: esKnow2.alignment
## Models:
## esKnow2.alignment.lmer: alignment ~ condition + movName + (1 | subid)
## esKnow2.alignment.lmer.B: alignment ~ condition * movName + (1 | subid)
## npar AIC BIC logLik deviance Chisq Df
## esKnow2.alignment.lmer 6 60.813 75.944 -24.406 48.813
## esKnow2.alignment.lmer.B 8 58.137 78.311 -21.069 42.137 6.6759 2
## Pr(>Chisq)
## esKnow2.alignment.lmer
## esKnow2.alignment.lmer.B 0.03551 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
joint_tests(esKnow2.alignment.lmer.B)
## model term df1 df2 F.ratio p.value
## condition 2 54.41 9.922 0.0002
## movName 1 55.28 9.832 0.0027
## condition:movName 2 55.28 3.283 0.0449
eta_squared(esKnow2.alignment.lmer.B, partial = TRUE)
## # Effect Size for ANOVA (Type III)
##
## Parameter | Eta2 (partial) | 90% CI
## -------------------------------------------------
## condition | 0.22 | [0.08, 0.34]
## movName | 0.14 | [0.03, 0.28]
## condition:movName | 0.10 | [0.00, 0.21]
Check if alignment is greater than 0
summary(emmeans(esKnow2.alignment.lmer, "condition",weights = "proportional"), infer=TRUE)
## condition emmean SE df lower.CL upper.CL t.ratio p.value
## Uninterrupted 0.588 0.0579 55.9 0.4717 0.704 10.146 <.0001
## Interrupted 0.365 0.0579 55.9 0.2486 0.481 6.295 <.0001
## Jumbled 0.221 0.0612 55.2 0.0984 0.344 3.611 0.0007
##
## Results are averaged over the levels of: movName
## Degrees-of-freedom method: kenward-roger
## Confidence level used: 0.95
summary(emmeans(esKnow2.alignment.lmer.B, "condition", by = "movName", contr = "pairwise", weights = "proportional", adjust = "holm")$contrasts, infer = TRUE)
## movName = 3Iron:
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted 0.3190 0.111 70.6 0.0469 0.591 2.875
## Uninterrupted - Jumbled 0.2578 0.116 85.9 -0.0243 0.540 2.232
## Interrupted - Jumbled -0.0613 0.116 85.9 -0.3433 0.221 -0.530
## p.value
## 0.0160
## 0.0565
## 0.5971
##
## movName = Corn:
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted 0.1209 0.111 70.6 -0.1513 0.393 1.089
## Uninterrupted - Jumbled 0.4710 0.116 85.9 0.1890 0.753 4.078
## Interrupted - Jumbled 0.3501 0.116 85.9 0.0681 0.632 3.031
## p.value
## 0.2797
## 0.0003
## 0.0064
##
## Degrees-of-freedom method: kenward-roger
## Confidence level used: 0.95
## Conf-level adjustment: bonferroni method for 3 estimates
## P value adjustment: holm method for 3 tests
esKnow2.enclosure.lmer <- lmer(enclosure~condition + movName + (1|subid), data = esKnow2.alignment)
esKnow2.enclosure.lmer.B <- lmer(enclosure~condition*movName + (1|subid), data = esKnow2.alignment)
anova(esKnow2.enclosure.lmer, esKnow2.enclosure.lmer.B)
## Data: esKnow2.alignment
## Models:
## esKnow2.enclosure.lmer: enclosure ~ condition + movName + (1 | subid)
## esKnow2.enclosure.lmer.B: enclosure ~ condition * movName + (1 | subid)
## npar AIC BIC logLik deviance Chisq Df
## esKnow2.enclosure.lmer 6 -123.18 -108.05 67.589 -135.18
## esKnow2.enclosure.lmer.B 8 -123.87 -103.69 69.935 -139.87 4.6919 2
## Pr(>Chisq)
## esKnow2.enclosure.lmer
## esKnow2.enclosure.lmer.B 0.09575 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
joint_tests(esKnow2.enclosure.lmer)
## model term df1 df2 F.ratio p.value
## condition 2 51.58 3.181 0.0498
## movName 1 56.24 2.461 0.1223
eta_squared(esKnow2.enclosure.lmer, partial = TRUE)
## # Effect Size for ANOVA (Type III)
##
## Parameter | Eta2 (partial) | 90% CI
## -----------------------------------------
## condition | 0.09 | [0.00, 0.19]
## movName | 0.04 | [0.00, 0.16]
Check if alignment is greater than 0
summary(emmeans(esKnow2.enclosure.lmer, "condition", null = 0.5), infer=TRUE)
## condition emmean SE df lower.CL upper.CL null t.ratio p.value
## Uninterrupted 0.610 0.0222 54.9 0.565 0.655 0.5 4.945 <.0001
## Interrupted 0.560 0.0222 54.9 0.515 0.604 0.5 2.677 0.0098
## Jumbled 0.531 0.0236 48.9 0.483 0.579 0.5 1.311 0.1961
##
## Results are averaged over the levels of: movName
## Degrees-of-freedom method: kenward-roger
## Confidence level used: 0.95
Alignment score for Jumbled is not better than chance.
summary(emmeans(esKnow2.enclosure.lmer, "condition", contr = "pairwise", weights = "proportional", adjust = "holm")$contrasts, infer = TRUE)
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted 0.0505 0.0297 84.3 -0.02202 0.123 1.701
## Uninterrupted - Jumbled 0.0790 0.0325 51.6 -0.00131 0.159 2.434
## Interrupted - Jumbled 0.0286 0.0325 51.6 -0.05177 0.109 0.880
## p.value
## 0.1854
## 0.0553
## 0.3831
##
## Results are averaged over the levels of: movName
## Degrees-of-freedom method: kenward-roger
## Confidence level used: 0.95
## Conf-level adjustment: bonferroni method for 3 estimates
## P value adjustment: holm method for 3 tests
###Plot alignment values
#create dataframe for annotations
esKnow2.alignment.plot.ann <- data.frame(xstart = c(1,1,1,2), xend = c(3,2,3,3),
ystart = c(2.3,1.9, 2.3, 1.9), yend = c(2.3, 1.9, 2.3, 1.9),
x = c(2, 1.5, 2, 2.5), y = c(2.45,1.97, 2.37, 1.97),
label = c("~", "*", "***", "**"),
movName = c("3Iron", "3Iron", "Corn", "Corn"))
esKnow2.alignment.plot <- ggplot(esKnow2.alignment, aes(x = condition, y = alignment, fill = condition, color = condition))+
geom_jitter(width = jitter.width, alpha = jitter.alpha - .1, shape = point.shape, color = jitter.outline, size = jitter.size)+
stat_summary(geom = "errorbar", fun.data = "mean_cl_normal", width = errorbar.width+.2, color = outline.color, alpha = errorbar.alpha, size = errorbar.size)+
geom_point(stat = "summary", fun = "mean", size = point.size-1, shape = point.shape, color = outline.color, stroke = point.stroke, legend = FALSE)+
#geom_signif()+
scale_fill_manual(values = colors$point.colors, labels = NULL, guide = "none")+
scale_color_manual(values = colors$point.colors, labels = NULL, guide = "none")+
scale_x_discrete(labels=c("U\n(Exp1)", "I", "J"))+
geom_segment(data = esKnow2.alignment.plot.ann, aes(x = xstart, y = ystart, xend = xend, yend = yend),
color = outline.color, size = 1, inherit.aes = FALSE)+
geom_text(data = esKnow2.alignment.plot.ann, aes(x = x, y = y, label = label), color = outline.color, size = 8, fontface = txt.face, inherit.aes = FALSE)+
facet_wrap(~movName, scales = "fixed", labeller = labeller(movName = c("3Iron" = "3Iron", "Corn" = "Corn")))+
# coord_cartesian(ylim=c(-1, 2.5))+
labs(y = "Exp-Obs Distance (s)", x = "", title = "")+
theme.esKnow
# esKnow2.alignment.plot <- ggplot(esKnow2.alignment, aes(condition, alignment, fill = condition, color = condition))+
# geom_jitter(width = jitter.width, alpha = jitter.alpha-.2, show.legend = FALSE, shape = point.shape, color = jitter.outline, size = jitter.size)+
# stat_summary(geom = "errorbar", fun.data = "mean_cl_normal", width = errorbar.width+.2, color = outline.color, alpha = errorbar.alpha, size = errorbar.size)+
# geom_point(stat = "summary", fun = "mean", size = point.size-1, alpha = point.alpha, shape = point.shape, color = outline.color, stroke = point.stroke, show.lengend = FALSE)+
# scale_fill_manual(values = colors$point.colors, labels = NULL, guide = "none")+
# scale_color_manual(values = colors$point.colors, labels = NULL, guide = "none")+
# # geom_segment(data = esKnow2.alignment.plot.ann, aes(x = xstart, y = ystart, xend = xend, yend = yend),
# # color = outline.color, size = 1, inherit.aes = FALSE)+
# # geom_text(data = esKnow2.alignment.plot.ann, aes(x = x, y = y, label = label), color = outline.color, size = 8, fontface = txt.face, inherit.aes = FALSE)+
# # geom_segment(aes(x = 1, y = 1.9, xend = 2, yend = 1.9), color = outline.color, size = 0.5) +
# # annotate("text", x = 1.5, y = 1.97, label = "***", color = outline.color, size = 8, fontface = txt.face) +
# # geom_segment(aes(x = 1, y = 2.3, xend = 3, yend = 2.3), color = outline.color, size = 0.5) +
# # annotate("text", x = 2, y = 2.37, label = "***", color = outline.color, size = 8, fontface = txt.face) +
# scale_x_discrete(labels=c("U\n(Exp1)", "I", "J"))+
# #coord_cartesian(ylim = c(-1, 2.5))+
# labs(y = "Expected-Observed (s)", x = "", title = "")+
# facet_wrap(~movName, scales = "fixed", labeller = )+
# theme.esKnow
esKnow2.alignment.plot
esKnow2.enclosure.plot.ann <- data.frame(xstart = c(1), xend = c(3),
ystart = c(1.2), yend = c(1.2),
x = c(2), y = c(1.3),
label = c("~"))
esKnow2.enclosure.plot <- ggplot(esKnow2.alignment, aes(condition, enclosure, fill = condition, color = condition))+
geom_jitter(width = jitter.width, alpha = jitter.alpha-0.2, show.legend = FALSE, shape = point.shape, color = jitter.outline, size = jitter.size)+
stat_summary(geom = "errorbar", fun.data = "mean_cl_normal", width = errorbar.width+.1, color = outline.color, size = errorbar.size)+
geom_point(stat = "summary", fun = "mean", size = point.size-1, alpha = point.alpha, shape = point.shape, color = outline.color, stroke = point.stroke, show.lengend = FALSE)+
scale_fill_manual(values = colors$point.colors, labels = NULL, guide = "none")+
scale_color_manual(values = colors$point.colors, labels = NULL, guide = "none")+
geom_segment(data = esKnow2.enclosure.plot.ann, aes(x = xstart, y = ystart, xend = xend, yend = yend),
color = outline.color, size = 1, inherit.aes = FALSE)+
geom_text(data = esKnow2.enclosure.plot.ann, aes(x = x, y = y, label = label),
color = outline.color, size = 8, fontface = txt.face, inherit.aes = FALSE)+
scale_x_discrete(labels=c("U\n(Exp1)", "I", "J"))+
scale_y_continuous(breaks = c(0, 0.5, 1), labels = c('0.0', '0.5', '1.0')) +
coord_cartesian(ylim = c(0,1.3)) +
#geom_segment(aes(x = 1, y = 1.1, xend = 2, yend = 1.1), color = outline.color, size = 0.5) +
annotate("text", x = 3, y = 0.85, label = "n.s.", color = outline.color, size = 5, fontface = txt.face) +
labs(x = "", y = "Enclosure ", title = "")+
theme.esKnow
esKnow2.enclosure.plot
Agreement index
esKnow2.agreement.index <- data.frame()
for(cond in unique(esKnow2.segmentdata$condition)){
for(movieName in unique(esKnow2.segmentdata$movName)){
if(movieName == "3Iron"){
mov.dur = iron.mov.dur
}else{
mov.dur = corn.mov.dur
}
for(segmentGrain in unique(esKnow2.segmentdata$grain)){
dat <- esKnow2.segmentdata[esKnow2.segmentdata$condition == cond & esKnow2.segmentdata$movName == movieName & esKnow2.segmentdata$grain == segmentGrain,]
for(sub in unique(dat$subid)){
sub.bp <- dat$bpTime.series[dat$subid == sub]
gp.bp <- dat$bpTime.series[dat$subid != sub]
#get subject bp timeseries
timeseries <- seq(from = 0, to = mov.dur-1, by = 1)
sub.ts <- as.numeric(timeseries %in% floor(sub.bp))
sub.rand.ts <- sample(sub.ts)
#get group bp timeseries
gp.timeseries <- unlist(tapply(gp.bp, dat$subid[dat$subid!=sub], function(x){return(as.numeric(timeseries %in% floor(x)))}))
gp.ts <- tapply(gp.timeseries, rep(timeseries, length(unique(dat$subid))-1), mean)
#get random timeseries
rand.subjects <- rep(sample(length(unique(dat$subid))-1), each = length(timeseries))
random.timeseries <- c()
for (s in unique(rand.subjects)){
random.timeseries <- c(random.timeseries, sample(gp.timeseries[rand.subjects == s]))
}
#random.timeseries <- unlist(tapply(gp.timeseries, rep(sample(length(unique(dat$subid))-1), each = length(timeseries)), sample))
random.ts <- tapply(random.timeseries, rep(timeseries, length(unique(dat$subid))-1), mean)
comparisons <- c(cond, "random", cond)
agreements <- rbind(get.agreement.index(sub.ts, gp.ts), get.agreement.index(sub.ts, random.ts), get.agreement.index(sub.rand.ts, gp.ts))
for(crossCond in unique(esKnow2.segmentdata$condition)[unique(esKnow2.segmentdata$condition)!= cond]){
crossdat <- esKnow2.segmentdata[esKnow2.segmentdata$condition == crossCond & esKnow2.segmentdata$movName == movieName & esKnow2.segmentdata$grain == segmentGrain,]
crossgp.bp <- crossdat$bpTime.series
crossgp.timeseries <- unlist(tapply(crossgp.bp, crossdat$subid, function(x){return(as.numeric(timeseries %in% floor(x)))}))
crossgp.ts <- tapply(crossgp.timeseries, rep(timeseries, length(unique(crossdat$subid))), mean)
comparisons <- c(comparisons, crossCond)
agreements <- rbind(agreements, get.agreement.index(sub.ts, crossgp.ts))
}
comp_types <- c("same", "random", "randomSub", "crossCond", "crossCond")
esKnow2.agreement.index <- rbind(esKnow2.agreement.index, data.frame(subid = rep(sub, length(comparisons)),
indiv_cond = factor(rep(cond, length(comparisons)), levels = condition.factor),
movName = rep(movieName, length(comparisons)),
grain = factor(rep(segmentGrain, length(comparisons)), levels = grain.factor),
group_cond = factor(comparisons, levels = c(condition.factor, "random")),
testCond_type = factor(comp_types),
min_corr = agreements[,1],
max_corr = agreements[,2],
act_corr = agreements[,3],
agreementIndex = agreements[,4]))
}
}
}
}
Compare individuals across all conditions when compared to uninterrupted group.
#test for (1)
esKnow2.agreement.withU <- esKnow2.agreement.index %>% dplyr::filter(group_cond == "Uninterrupted", testCond_type != "randomSub") %>% droplevels()
esKnow2.agreement.withU.lmer <- lmer(agreementIndex~indiv_cond*grain + movName + (1|subid), data = esKnow2.agreement.withU)
esKnow2.agreement.withU.lmer.B <- lmer(agreementIndex~indiv_cond*grain*movName + (1|subid), data = esKnow2.agreement.withU)
anova(esKnow2.agreement.withU.lmer, esKnow2.agreement.withU.lmer.B)
## Data: esKnow2.agreement.withU
## Models:
## esKnow2.agreement.withU.lmer: agreementIndex ~ indiv_cond * grain + movName + (1 | subid)
## esKnow2.agreement.withU.lmer.B: agreementIndex ~ indiv_cond * grain * movName + (1 | subid)
## npar AIC BIC logLik deviance Chisq Df
## esKnow2.agreement.withU.lmer 9 -407.37 -378.15 212.69 -425.37
## esKnow2.agreement.withU.lmer.B 14 -401.05 -355.60 214.53 -429.05 3.6827 5
## Pr(>Chisq)
## esKnow2.agreement.withU.lmer
## esKnow2.agreement.withU.lmer.B 0.5959
joint_tests(esKnow2.agreement.withU.lmer)
## model term df1 df2 F.ratio p.value
## indiv_cond 2 181.87 16.168 <.0001
## grain 1 125.69 237.697 <.0001
## movName 1 125.26 0.210 0.6474
## indiv_cond:grain 2 139.28 5.281 0.0062
eta_squared(esKnow2.agreement.withU.lmer)
## # Effect Size for ANOVA (Type III)
##
## Parameter | Eta2 (partial) | 90% CI
## ------------------------------------------------
## indiv_cond | 0.22 | [0.11, 0.32]
## grain | 0.66 | [0.59, 0.72]
## movName | 1.73e-03 | [0.00, 0.03]
## indiv_cond:grain | 0.07 | [0.01, 0.14]
summary(emmeans(esKnow2.agreement.withU.lmer, "indiv_cond", by = "grain"))
## grain = c:
## indiv_cond emmean SE df lower.CL upper.CL
## Uninterrupted 0.324 0.0156 132 0.293 0.355
## Interrupted 0.342 0.0157 113 0.311 0.373
## Jumbled 0.222 0.0168 117 0.189 0.255
##
## grain = f:
## indiv_cond emmean SE df lower.CL upper.CL
## Uninterrupted 0.528 0.0156 133 0.497 0.559
## Interrupted 0.490 0.0157 113 0.459 0.521
## Jumbled 0.471 0.0153 113 0.441 0.502
##
## Results are averaged over the levels of: movName
## Degrees-of-freedom method: kenward-roger
## Confidence level used: 0.95
summary(emmeans(esKnow2.agreement.withU.lmer, "indiv_cond", by = "grain", contr = list(UvsI = c(1, -1,0),
UvsJ = c(1, 0, -1)), weights = "proportional", adjust = "holm")$contrasts, infer = TRUE)
## grain = c:
## contrast estimate SE df lower.CL upper.CL t.ratio p.value
## UvsI -0.0179 0.0197 171 -0.0624 0.0265 -0.913 0.3625
## UvsJ 0.1022 0.0229 124 0.0502 0.1541 4.461 <.0001
##
## grain = f:
## contrast estimate SE df lower.CL upper.CL t.ratio p.value
## UvsI 0.0385 0.0221 123 -0.0117 0.0888 1.742 0.0841
## UvsJ 0.0569 0.0197 179 0.0124 0.1013 2.889 0.0087
##
## Results are averaged over the levels of: movName
## Degrees-of-freedom method: kenward-roger
## Confidence level used: 0.95
## Conf-level adjustment: bonferroni method for 2 estimates
## P value adjustment: holm method for 2 tests
summary(emmeans(esKnow2.agreement.withU.lmer, c("indiv_cond", "grain"), contr = list(UvsI = c(1, -1,0, -1, 1, 0),
UvsJ = c(1, 0, -1, -1, 0 , 1)), weights = "proportional", adjust = "holm")$contrasts, infer = TRUE)
## contrast estimate SE df lower.CL upper.CL t.ratio p.value
## UvsI -0.0565 0.0305 152 -0.1255 0.0125 -1.853 0.1317
## UvsJ 0.0453 0.0314 139 -0.0258 0.1164 1.444 0.1509
##
## Results are averaged over the levels of: movName
## Degrees-of-freedom method: kenward-roger
## Confidence level used: 0.95
## Conf-level adjustment: bonferroni method for 2 estimates
## P value adjustment: holm method for 2 tests
summary(emmeans(esKnow2.agreement.withU.lmer, c("indiv_cond", "grain")))
## indiv_cond grain emmean SE df lower.CL upper.CL
## Uninterrupted c 0.324 0.0156 132 0.293 0.355
## Interrupted c 0.342 0.0157 113 0.311 0.373
## Jumbled c 0.222 0.0168 117 0.189 0.255
## Uninterrupted f 0.528 0.0156 133 0.497 0.559
## Interrupted f 0.490 0.0157 113 0.459 0.521
## Jumbled f 0.471 0.0153 113 0.441 0.502
##
## Results are averaged over the levels of: movName
## Degrees-of-freedom method: kenward-roger
## Confidence level used: 0.95
There is a main effect of individual condition on agreement index, suggesting that when compared to Uninterrupted group, Interrupted or Jumbled individuals performed differently to uninterrupted individuals (as measured by agreement index). Post hoc test revealed that agreement index was lower for both fine and coarse segmentation for jumbled participants but only in fine segmentation for interrupted participants.
Plot segmentation agreement of different individual conditions compared to uninterrupted group
#create dataframes to plot line segments and annotations
ann_line<-data.frame(xStart=c(1,1),xEnd= c(2,3), yStart=c(.75,.9),yEnd=c(.75,.9),
grain=factor(c("c", "c"),levels=grain.factor))
ann_text<-data.frame(x=c(1.5,2), y=c(.775,.925),
text = c("***", "**"),
grain=factor(c("c", "c"),levels=grain.factor))
esKnow2.agreementIndex_indivVSUgroup_plot <- ggplot(esKnow2.agreement.withU, aes(x = indiv_cond, y = agreementIndex, fill = indiv_cond, color = indiv_cond))+
geom_jitter(width = jitter.width, alpha = jitter.alpha-.2, shape = point.shape, color = jitter.outline, size = jitter.size)+
stat_summary(geom = "errorbar", fun.data = "mean_cl_normal", width = errorbar.width + .1, color = outline.color, alpha = errorbar.alpha, size = errorbar.size)+
geom_point(stat = "summary", fun = "mean", size = point.size-1, shape = point.shape, color = outline.color, stroke = point.stroke, legend = FALSE)+
#geom_signif()+
scale_fill_manual(values = colors$point.colors, labels = NULL, guide = "none")+
scale_color_manual(values = colors$point.colors, labels = NULL, guide = "none")+
scale_x_discrete(labels=c("U\n(Exp1)", "I", "J"))+ #\n(Exp1)
geom_segment(data = ann_line, aes(x = xStart, y = yStart, xend = xEnd, yend = yEnd), color = outline.color, size = 1, inherit.aes = FALSE) +
geom_text(data = ann_text, aes(x = x, y = y, label = text), color = outline.color, size = 8, fontface = txt.face, inherit.aes = FALSE) +
facet_wrap(~grain, scales = "fixed", labeller = labeller(grain = c("c" = "Coarse", "f" = "Fine")))+
coord_cartesian(ylim=c(0, 1))+
labs(y = "Agreement Index", x = "Individual") +
theme.esKnow
esKnow2.agreementIndex_indivVSUgroup_plot
##Create figure for segmentation results from esKnow2 (Figure 4)
figS6_top <- ggarrange(esKnow2.bpRate_plot, esKnow2.alignment.plot,
labels = c("A", "B"),
ncol = 2, nrow = 1)
figS6_middle <- ggarrange(esKnow2.enclosure.plot, esKnow2.agreementIndex_indivVSUgroup_plot,
labels = c("C", "D"),
widths = c(1, 1.5),
ncol = 2, nrow = 1)
#fig4_bottom <- ggarrange(esKnow2.coarse.dens, esKnow2.fine.dens,
# nrow = 2, ncol = 1)
figureS6 <- ggarrange(figS6_top, figS6_middle,
labels = c("", ""),
ncol = 1, nrow = 2)
figureS6
# setwd('../plots/')
# ggsave("esKnow2_segmentation_figureS6.pdf", plot = figureS6, width = 9, height = 9, device = cairo_pdf)
# pdf_convert(pdf = "esKnow2_segmentation_figureS6.pdf", format = "png", dpi = 300,
# filenames = "esKnow2_segmentation_figureS6.png")
Overall number of events recalled
Granularity of segmentation in esKnow2 were performed between subjects. Examine overall recall rate for each segmentation grain.
#assign segmentation grain condition
for (i in 1:nrow(esKnow2.recall)){
esKnow2.recall$grain[i] <- esKnow2.pseudoIndex$grain[esKnow2.pseudoIndex$newIndex == esKnow2.recall$pseudo_subid[i]]
}
esKnow2.recall$grain <- factor(esKnow2.recall$grain, levels = grain.factor)
esKnow2.recallRate <- esKnow2.recall %>% dplyr::group_by(condition, exp_subid, movName, grain, separated) %>% dplyr::summarise(n.events = sum(recall))
for(r in 1:nrow(esKnow2.recallRate)){
if(esKnow2.recallRate$movName[r] == "3Iron"){
if(esKnow2.recallRate$separated[r]){
esKnow2.recallRate$recallRate[r] = esKnow2.recallRate$n.events[r]/length(iron_separated)
}else{
esKnow2.recallRate$recallRate[r] = esKnow2.recallRate$n.events[r]/(74-length(iron_separated))
}
}else{
if(esKnow2.recallRate$separated[r]){
esKnow2.recallRate$recallRate[r] = esKnow2.recallRate$n.events[r]/length(corn_separated)
}else{
esKnow2.recallRate$recallRate[r] = esKnow2.recallRate$n.events[r]/(69 - length(corn_separated))
}
}
}
Recall rate divided by grain
esKnow2.recallRate.grain.lmer <- lmer(recallRate~condition*grain + movName + (1|exp_subid), data = esKnow2.recallRate)
esKnow2.recallRate.grain.lmer.B <- lmer(recallRate~condition*grain*movName + (1|exp_subid), data = esKnow2.recallRate)
anova(esKnow2.recallRate.grain.lmer, esKnow2.recallRate.grain.lmer.B)
## Data: esKnow2.recallRate
## Models:
## esKnow2.recallRate.grain.lmer: recallRate ~ condition * grain + movName + (1 | exp_subid)
## esKnow2.recallRate.grain.lmer.B: recallRate ~ condition * grain * movName + (1 | exp_subid)
## npar AIC BIC logLik deviance Chisq Df
## esKnow2.recallRate.grain.lmer 9 -446.30 -410.94 232.15 -464.30
## esKnow2.recallRate.grain.lmer.B 14 -441.65 -386.64 234.83 -469.65 5.3504 5
## Pr(>Chisq)
## esKnow2.recallRate.grain.lmer
## esKnow2.recallRate.grain.lmer.B 0.3746
joint_tests(esKnow2.recallRate.grain.lmer)
## model term df1 df2 F.ratio p.value
## condition 2 88 2.764 0.0685
## grain 1 88 1.384 0.2427
## movName 1 281 96.084 <.0001
## condition:grain 2 88 1.419 0.2474
There is no influence of segmentation grain on recall accuracy. Subsequent analyses will be done collapsed across grain.
summary(emmeans(esKnow2.recallRate.grain.lmer, "condition", contr = "pairwise", weights = "proportional", adjust = "holm")$contrasts, infer = TRUE)
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted -0.04588 0.0225 88 -0.1008 0.00907 -2.038
## Uninterrupted - Jumbled -0.04406 0.0227 88 -0.0995 0.01134 -1.941
## Interrupted - Jumbled 0.00182 0.0225 88 -0.0532 0.05681 0.081
## p.value
## 0.1337
## 0.1337
## 0.9357
##
## Results are averaged over the levels of: grain, movName
## Degrees-of-freedom method: kenward-roger
## Confidence level used: 0.95
## Conf-level adjustment: bonferroni method for 3 estimates
## P value adjustment: holm method for 3 tests
esKnow2.recallRate_plot <- ggplot(esKnow2.recallRate, aes(x = condition, y = recallRate, fill = interaction(condition, grain), color = interaction(condition, grain)))+
geom_jitter(alpha = .7, position = position_jitterdodge(.8), size = 1.5)+
stat_summary(geom = "errorbar", fun.data = "mean_cl_normal", width = 0.5, color = outline.color, alpha = errorbar.alpha, position =position_dodge(0.5), size = 1) +
geom_point(stat = "summary", fun = "mean", size = 4, shape = 21, color = outline.color, position = position_dodge(0.5), stroke = 1.2) +
scale_fill_manual(values = colors$point.colors)+
scale_color_manual(values = colors$point.colors)+
scale_x_discrete(labels=c("Uninterrupted" = "U", "Interrupted" = "I",
"Jumbled" = "J"))+
#facet_wrap(~grain, scales='fixed', labeller = labeller(grain = c("c" = "Coarse", "f" = "Fine")))+
#geom_segment(aes(x = 2, y = 1.05, xend = 3, yend = 1.05), color = outline.color, size = 0.5) +
#nnotate("text", x = 2.5, y = 1.08, label = "*", color = outline.color, size = 8) +
#geom_segment(aes(x = 1, y = 1.2, xend = 3, yend = 1.2), color = outline.color, size = 0.5) +
#annotate("text", x = 2, y = 1.23, label = "***", color = outline.color, size = 8) +
coord_cartesian(ylim = c(0,1))+
scale_y_continuous(breaks = c(0, 0.5, 1), labels = c('0.0', '0.5', '1.0'))+
labs(y = "Recall rate", x = "")+
theme(legend.position = 'none') +
theme.esKnow
esKnow2.recallRate_plot
Recall Time
esKnow2.recallTime_rate <- esKnow2.recallTime %>% dplyr::group_by(condition, subid, movName, grain) %>% dplyr::summarise(ave_time = mean(as.numeric(recall_time)/1000, na.rm = TRUE))
esKnow2.recallTime.lmer <- lmer(ave_time~condition + movName + (1|subid), data = esKnow2.recallTime_rate)
esKnow2.recallTime.lmer.B <- lmer(ave_time~condition*movName + (1|subid), data = esKnow2.recallTime_rate)
anova(esKnow2.recallTime.lmer, esKnow2.recallTime.lmer.B)
## Data: esKnow2.recallTime_rate
## Models:
## esKnow2.recallTime.lmer: ave_time ~ condition + movName + (1 | subid)
## esKnow2.recallTime.lmer.B: ave_time ~ condition * movName + (1 | subid)
## npar AIC BIC logLik deviance Chisq Df
## esKnow2.recallTime.lmer 6 1076.7 1096.1 -532.35 1064.7
## esKnow2.recallTime.lmer.B 8 1079.7 1105.6 -531.85 1063.7 1.0036 2
## Pr(>Chisq)
## esKnow2.recallTime.lmer
## esKnow2.recallTime.lmer.B 0.6054
joint_tests(esKnow2.recallTime.lmer)
## model term df1 df2 F.ratio p.value
## condition 2 91 0.341 0.7122
## movName 1 93 1.269 0.2629
esKnow2.recallTime_plot <- ggplot(esKnow2.recallTime_rate, aes(x = condition, y = ave_time, fill = condition, color = condition))+
geom_jitter(alpha = jitter.alpha-.2, position = position_jitterdodge(.7), size = jitter.size, shape = point.shape, color = jitter.outline)+
stat_summary(geom = "errorbar", fun.data = "mean_cl_normal", width = errorbar.width, color = outline.color, alpha = errorbar.alpha, position =position_dodge(0.5), size = errorbar.size-.2) +
geom_point(stat = "summary", fun = "mean", size = point.size-1, shape = 21, color = outline.color, position = position_dodge(0.5), stroke = point.stroke-.2) +
scale_fill_manual(values = colors$point.colors)+
scale_color_manual(values = colors$point.colors)+
scale_x_discrete(labels=c("Uninterrupted" = "U", "Interrupted" = "I",
"Jumbled" = "J"))+
# geom_segment(aes(x = 2, y = 1.05, xend = 3, yend = 1.05), color = outline.color, size = 0.5) +
# annotate("text", x = 2.5, y = 1.08, label = "*", color = outline.color, size = 8) +
# geom_segment(aes(x = 1, y = 1.2, xend = 3, yend = 1.2), color = outline.color, size = 0.5) +
# annotate("text", x = 2, y = 1.23, label = "***", color = outline.color, size = 8) +
coord_cartesian(ylim = c(0,10))+
scale_y_continuous(breaks = c(0, 5, 10), labels = c('0', '5', '10'))+
labs(y = "Recall time (s)", x = "")+
theme(legend.position = 'none') +
theme.esKnow
esKnow2.recallTime_plot
Semantic Clustering
esKnow2.semClust.lm <- lm(sem_clustering~condition + movName , data = esKnow2.clustering)
esKnow2.semClust.lm.B <- lm(sem_clustering~condition*movName , data = esKnow2.clustering)
anova(esKnow2.semClust.lm, esKnow2.semClust.lm.B)
## Analysis of Variance Table
##
## Model 1: sem_clustering ~ condition + movName
## Model 2: sem_clustering ~ condition * movName
## Res.Df RSS Df Sum of Sq F Pr(>F)
## 1 182 2.1771
## 2 180 2.1485 2 0.028548 1.1958 0.3048
joint_tests(esKnow2.semClust.lm)
## model term df1 df2 F.ratio p.value
## condition 2 182 1.306 0.2735
## movName 1 182 1.472 0.2266
summary(emmeans(esKnow2.semClust.lm, "condition", null = 0.5), infer = TRUE)
## condition emmean SE df lower.CL upper.CL null t.ratio p.value
## Uninterrupted 0.595 0.0140 182 0.568 0.623 0.5 6.796 <.0001
## Interrupted 0.621 0.0138 182 0.594 0.648 0.5 8.765 <.0001
## Jumbled 0.624 0.0139 182 0.597 0.652 0.5 8.958 <.0001
##
## Results are averaged over the levels of: movName
## Confidence level used: 0.95
esKnow2.semanticClustering_plot <- ggplot(esKnow2.clustering, aes(x = condition, y = sem_clustering, fill = condition, color = condition, grain))+
geom_jitter(alpha = jitter.alpha-.2, position = position_jitterdodge(.8), size = jitter.size, shape = point.shape, color = jitter.outline)+
stat_summary(geom = "errorbar", fun.data = "mean_cl_normal", width = 0.4, color = outline.color, alpha = errorbar.alpha, position =position_dodge(0.5), size = errorbar.size-.2) +
geom_point(stat = "summary", fun = "mean", size = point.size-1, shape = 21, color = outline.color, position = position_dodge(0.5), stroke = point.stroke-.2) +
scale_fill_manual(values = colors$point.colors)+
scale_color_manual(values = colors$point.colors)+
scale_x_discrete(labels=c("Uninterrupted" = "U", "Interrupted" = "I",
"Jumbled" = "J"))+
#facet_wrap(~grain, scales='fixed', labeller = labeller(grain = c("c" = "Coarse", "f" = "Fine")))+
#geom_segment(aes(x = 2, y = 1.05, xend = 3, yend = 1.05), color = outline.color, size = 0.5) +
#nnotate("text", x = 2.5, y = 1.08, label = "*", color = outline.color, size = 8) +
#geom_segment(aes(x = 1, y = 1.2, xend = 3, yend = 1.2), color = outline.color, size = 0.5) +
#annotate("text", x = 2, y = 1.23, label = "***", color = outline.color, size = 8) +
coord_cartesian(ylim = c(0,1))+
scale_y_continuous(breaks = c(0, 0.5, 1), labels = c('0.0', '0.5', '1.0'))+
labs(y = "Semantic clustering", x = "", title = " ")+
theme(legend.position = 'none') +
theme.esKnow
esKnow2.semanticClustering_plot
Temporal clustering
esKnow2.tempClust.lmer <- lmer(temp_clustering~condition + movName + (1|exp_subid) , data = esKnow2.clustering)
esKnow2.tempClust.lmer.B <- lmer(temp_clustering~condition*movName + (1|exp_subid) , data = esKnow2.clustering)
anova(esKnow2.tempClust.lmer, esKnow2.tempClust.lmer.B)
## Data: esKnow2.clustering
## Models:
## esKnow2.tempClust.lmer: temp_clustering ~ condition + movName + (1 | exp_subid)
## esKnow2.tempClust.lmer.B: temp_clustering ~ condition * movName + (1 | exp_subid)
## npar AIC BIC logLik deviance Chisq Df
## esKnow2.tempClust.lmer 6 -192.22 -172.87 102.11 -204.22
## esKnow2.tempClust.lmer.B 8 -195.19 -169.39 105.60 -211.19 6.9711 2
## Pr(>Chisq)
## esKnow2.tempClust.lmer
## esKnow2.tempClust.lmer.B 0.03064 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
joint_tests(esKnow2.tempClust.lmer.B)
## model term df1 df2 F.ratio p.value
## condition 2 90.43 13.632 <.0001
## movName 1 90.25 0.429 0.5142
## condition:movName 2 90.04 3.509 0.0341
eta_squared(esKnow2.tempClust.lmer.B)
## # Effect Size for ANOVA (Type III)
##
## Parameter | Eta2 (partial) | 90% CI
## -------------------------------------------------
## condition | 0.23 | [0.11, 0.35]
## movName | 4.77e-03 | [0.00, 0.06]
## condition:movName | 0.07 | [0.00, 0.16]
summary(emmeans(esKnow2.tempClust.lmer.B, "condition", by = "movName",contr = "pairwise", weights = "proportional", adjust = "holm")$contrasts, infer = TRUE)
## movName = 3Iron:
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted 0.00274 0.0358 174 -0.0837 0.0892 0.077
## Uninterrupted - Jumbled 0.13280 0.0360 174 0.0457 0.2199 3.684
## Interrupted - Jumbled 0.13006 0.0355 173 0.0443 0.2158 3.666
## p.value
## 0.9390
## 0.0009
## 0.0009
##
## movName = Corn:
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted -0.11200 0.0358 174 -0.1984 -0.0256 -3.133
## Uninterrupted - Jumbled 0.04299 0.0358 173 -0.0434 0.1294 1.202
## Interrupted - Jumbled 0.15499 0.0358 174 0.0686 0.2414 4.335
## p.value
## 0.0041
## 0.2309
## 0.0001
##
## Degrees-of-freedom method: kenward-roger
## Confidence level used: 0.95
## Conf-level adjustment: bonferroni method for 3 estimates
## P value adjustment: holm method for 3 tests
Even though the overall number of events recalled are similar across condition, Jumbled participants have lower temporal clustering score compared to Uninterrupted and Interrupted condition.
esKnow2.temporalClustering_ann <- data.frame(xstart = c(1,2,2,1), xend = c(3,3,3,2),
ystart = c(1.23, 1.1, 1.23, 1.1), yend = c(1.23, 1.1, 1.23, 1.1),
x = c(2,2.5,2.5,1.5), y = c(1.25, 1.13, 1.25, 1.13),
labels = c('***', '***', '***', '**'),
movName = c("3Iron", '3Iron', 'Corn', 'Corn')
)
esKnow2.temporalClustering_plot <- ggplot(esKnow2.clustering, aes(x = condition, y = temp_clustering, fill = condition, color = condition, grain))+
geom_jitter(alpha = jitter.alpha - .2, position = position_jitterdodge(.8), size = jitter.size, shape = point.shape, color = jitter.outline)+
stat_summary(geom = "errorbar", fun.data = "mean_cl_normal", width = errorbar.width, color = outline.color, alpha = errorbar.alpha, position =position_dodge(0.5), size = errorbar.size-.2) +
geom_point(stat = "summary", fun = "mean", size = point.size-1, shape = 21, color = outline.color, position = position_dodge(0.5), stroke = point.stroke-.2) +
scale_fill_manual(values = colors$point.colors)+
scale_color_manual(values = colors$point.colors)+
scale_x_discrete(labels=c("Uninterrupted" = "U", "Interrupted" = "I",
"Jumbled" = "J"))+
facet_wrap(~grain, scales='fixed', labeller = labeller(grain = c("c" = "Coarse", "f" = "Fine")))+
geom_segment(data = esKnow2.temporalClustering_ann, aes(x = xstart, y = ystart, xend = xend, yend = yend),color = outline.color, size = 0.5, inherit.aes = FALSE)+
geom_text(data = esKnow2.temporalClustering_ann, aes(x = x, y = y, label = labels), color = outline.color, size = 6, inherit.aes = FALSE)+
facet_wrap(~movName)+
coord_cartesian(ylim = c(0,1.3), clip = "off")+
scale_y_continuous(breaks = c(0, 0.5, 1), labels = c('0.0', '0.5', '1.0'))+
labs(y = "Temporal clustering", x = "")+
theme(legend.position = 'none') +
theme.esKnow
esKnow2.temporalClustering_plot
# setwd('../plots/')
# ggsave("esKnow2_temporalClustering_wUninterrupted.pdf", plot = esKnow2.temporalClustering_plot, width = 4, height = 4, device = cairo_pdf)
# pdf_convert(pdf = "esKnow2_temporalClustering_wUninterrupted.pdf", format = "png", dpi = 300,
# filenames = "esKnow2_tempotalClustering_wUninterrupted.png")
LagCRP
lags_to_plot <- c('X.5', 'X.4', 'X.3', 'X.2', 'X.1', 'X0',
'X1', 'X2', 'X3', 'X4', 'X5')
esKnow2.lagCRP_long <- esKnow2.lagCRP %>% gather(lag, prob, -exp_subid, -condition, -pseudo_subid, -movName)
esKnow2.lagCRP_long$lag <- as.factor(esKnow2.lagCRP_long$lag)
esKnow2.lagCRP_long <- esKnow2.lagCRP_long[esKnow2.lagCRP_long$lag %in% lags_to_plot, ]
esKnow2.lagCRP_long <- transform(esKnow2.lagCRP_long, lag = factor(lag, levels = lags_to_plot))
esKnow2.lagCRP_long$prob <- as.numeric(esKnow2.lagCRP_long$prob)
esKnow2.lagCRP.lagDiff.lmer <- lmer(prob ~ lag*condition+movName + (1|exp_subid) , data = esKnow2.lagCRP_long)
esKnow2.lagCRP.lagDiff.lmer.B <- lmer(prob ~ lag*condition*movName + (1|exp_subid) , data = esKnow2.lagCRP_long)
anova(esKnow2.lagCRP.lagDiff.lmer, esKnow2.lagCRP.lagDiff.lmer.B)
## Data: esKnow2.lagCRP_long
## Models:
## esKnow2.lagCRP.lagDiff.lmer: prob ~ lag * condition + movName + (1 | exp_subid)
## esKnow2.lagCRP.lagDiff.lmer.B: prob ~ lag * condition * movName + (1 | exp_subid)
## npar AIC BIC logLik deviance Chisq Df
## esKnow2.lagCRP.lagDiff.lmer 33 -5376.8 -5194.2 2721.4 -5442.8
## esKnow2.lagCRP.lagDiff.lmer.B 62 -5377.6 -5034.6 2750.8 -5501.6 58.799 29
## Pr(>Chisq)
## esKnow2.lagCRP.lagDiff.lmer
## esKnow2.lagCRP.lagDiff.lmer.B 0.0008693 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
joint_tests(esKnow2.lagCRP.lagDiff.lmer.B)
## model term df1 df2 F.ratio p.value
## lag 9 1719.19 52.704 <.0001
## condition 2 91.06 5.933 0.0038
## movName 1 1728.42 2.386 0.1226
## lag:condition 18 1719.19 3.957 <.0001
## lag:movName 9 1719.19 2.434 0.0095
## condition:movName 2 1732.70 3.218 0.0403
## lag:condition:movName 18 1719.19 1.647 0.0423
eta_squared(esKnow2.lagCRP.lagDiff.lmer.B, partial = TRUE)
## # Effect Size for ANOVA (Type III)
##
## Parameter | Eta2 (partial) | 90% CI
## -----------------------------------------------------
## lag | 0.22 | [0.19, 0.24]
## condition | 0.12 | [0.02, 0.22]
## movName | 1.38e-03 | [0.00, 0.01]
## lag:condition | 0.04 | [0.02, 0.05]
## lag:movName | 0.01 | [0.00, 0.02]
## condition:movName | 3.71e-03 | [0.00, 0.01]
## lag:condition:movName | 0.02 | [0.00, 0.02]
Compare difference in probability of recall across conditions for each lag
summary(emmeans(esKnow2.lagCRP.lagDiff.lmer.B, "condition", by = c("lag", "movName"), weights = "proportional", contr = "pairwise", adjust= "holm")$contrasts, infer = TRUE)
## lag = X.5, movName = 3Iron:
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted 0.003487 0.0144 1802 -0.03095 0.03792 0.243
## Uninterrupted - Jumbled -0.001555 0.0145 1802 -0.03626 0.03315 -0.107
## Interrupted - Jumbled -0.005043 0.0142 1802 -0.03919 0.02910 -0.354
## p.value
## 1.0000
## 1.0000
## 1.0000
##
## lag = X.4, movName = 3Iron:
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted -0.004164 0.0144 1802 -0.03860 0.03027 -0.290
## Uninterrupted - Jumbled 0.007527 0.0145 1802 -0.02717 0.04223 0.520
## Interrupted - Jumbled 0.011691 0.0142 1802 -0.02245 0.04584 0.820
## p.value
## 1.0000
## 1.0000
## 1.0000
##
## lag = X.3, movName = 3Iron:
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted -0.001590 0.0144 1802 -0.03602 0.03284 -0.111
## Uninterrupted - Jumbled -0.001785 0.0145 1802 -0.03649 0.03292 -0.123
## Interrupted - Jumbled -0.000195 0.0142 1802 -0.03434 0.03395 -0.014
## p.value
## 1.0000
## 1.0000
## 1.0000
##
## lag = X.2, movName = 3Iron:
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted 0.002816 0.0144 1802 -0.03162 0.03725 0.196
## Uninterrupted - Jumbled 0.005404 0.0145 1802 -0.02930 0.04010 0.373
## Interrupted - Jumbled 0.002588 0.0142 1802 -0.03156 0.03673 0.182
## p.value
## 1.0000
## 1.0000
## 1.0000
##
## lag = X.1, movName = 3Iron:
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted -0.015073 0.0144 1802 -0.04951 0.01936 -1.049
## Uninterrupted - Jumbled -0.056262 0.0145 1802 -0.09096 -0.02156 -3.885
## Interrupted - Jumbled -0.041189 0.0142 1802 -0.07533 -0.00704 -2.890
## p.value
## 0.2944
## 0.0003
## 0.0078
##
## lag = X1, movName = 3Iron:
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted -0.023784 0.0144 1802 -0.05822 0.01065 -1.655
## Uninterrupted - Jumbled 0.013547 0.0145 1802 -0.02115 0.04825 0.935
## Interrupted - Jumbled 0.037331 0.0142 1802 0.00319 0.07148 2.620
## p.value
## 0.1961
## 0.3497
## 0.0266
##
## lag = X2, movName = 3Iron:
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted -0.014305 0.0144 1802 -0.04874 0.02013 -0.995
## Uninterrupted - Jumbled 0.000202 0.0145 1802 -0.03450 0.03490 0.014
## Interrupted - Jumbled 0.014507 0.0142 1802 -0.01964 0.04865 1.018
## p.value
## 0.9264
## 0.9889
## 0.9264
##
## lag = X3, movName = 3Iron:
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted 0.016460 0.0144 1802 -0.01797 0.05089 1.145
## Uninterrupted - Jumbled 0.042713 0.0145 1802 0.00801 0.07741 2.949
## Interrupted - Jumbled 0.026253 0.0142 1802 -0.00789 0.06040 1.842
## p.value
## 0.2522
## 0.0097
## 0.1312
##
## lag = X4, movName = 3Iron:
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted 0.018481 0.0144 1802 -0.01595 0.05291 1.286
## Uninterrupted - Jumbled 0.047901 0.0145 1802 0.01320 0.08260 3.308
## Interrupted - Jumbled 0.029419 0.0142 1802 -0.00473 0.06357 2.065
## p.value
## 0.1986
## 0.0029
## 0.0782
##
## lag = X5, movName = 3Iron:
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted 0.023463 0.0144 1802 -0.01097 0.05790 1.633
## Uninterrupted - Jumbled 0.042236 0.0145 1802 0.00754 0.07694 2.917
## Interrupted - Jumbled 0.018773 0.0142 1802 -0.01537 0.05292 1.317
## p.value
## 0.2054
## 0.0107
## 0.2054
##
## lag = X.5, movName = Corn:
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted 0.003912 0.0142 1802 -0.03023 0.03806 0.275
## Uninterrupted - Jumbled -0.006487 0.0144 1802 -0.04090 0.02793 -0.452
## Interrupted - Jumbled -0.010399 0.0142 1802 -0.04454 0.02375 -0.730
## p.value
## 1.0000
## 1.0000
## 1.0000
##
## lag = X.4, movName = Corn:
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted -0.012033 0.0142 1802 -0.04618 0.02211 -0.844
## Uninterrupted - Jumbled -0.009424 0.0144 1802 -0.04384 0.02499 -0.656
## Interrupted - Jumbled 0.002609 0.0142 1802 -0.03154 0.03675 0.183
## p.value
## 1.0000
## 1.0000
## 1.0000
##
## lag = X.3, movName = Corn:
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted -0.001227 0.0142 1802 -0.03537 0.03292 -0.086
## Uninterrupted - Jumbled -0.007101 0.0144 1802 -0.04152 0.02732 -0.494
## Interrupted - Jumbled -0.005873 0.0142 1802 -0.04002 0.02827 -0.412
## p.value
## 1.0000
## 1.0000
## 1.0000
##
## lag = X.2, movName = Corn:
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted -0.016349 0.0142 1802 -0.05049 0.01780 -1.147
## Uninterrupted - Jumbled -0.017745 0.0144 1802 -0.05216 0.01667 -1.236
## Interrupted - Jumbled -0.001396 0.0142 1802 -0.03554 0.03275 -0.098
## p.value
## 0.6504
## 0.6504
## 0.9220
##
## lag = X.1, movName = Corn:
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted -0.015093 0.0142 1802 -0.04924 0.01905 -1.059
## Uninterrupted - Jumbled -0.016586 0.0144 1802 -0.05100 0.01783 -1.155
## Interrupted - Jumbled -0.001494 0.0142 1802 -0.03564 0.03265 -0.105
## p.value
## 0.7449
## 0.7449
## 0.9165
##
## lag = X1, movName = Corn:
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted -0.070268 0.0142 1802 -0.10441 -0.03612 -4.931
## Uninterrupted - Jumbled 0.004357 0.0144 1802 -0.03006 0.03877 0.303
## Interrupted - Jumbled 0.074624 0.0142 1802 0.04048 0.10877 5.237
## p.value
## <.0001
## 0.7617
## <.0001
##
## lag = X2, movName = Corn:
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted 0.008814 0.0142 1802 -0.02533 0.04296 0.619
## Uninterrupted - Jumbled 0.032192 0.0144 1802 -0.00222 0.06661 2.241
## Interrupted - Jumbled 0.023377 0.0142 1802 -0.01077 0.05752 1.641
## p.value
## 0.5363
## 0.0754
## 0.2021
##
## lag = X3, movName = Corn:
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted 0.012576 0.0142 1802 -0.02157 0.04672 0.883
## Uninterrupted - Jumbled 0.037317 0.0144 1802 0.00290 0.07173 2.598
## Interrupted - Jumbled 0.024740 0.0142 1802 -0.00941 0.05889 1.736
## p.value
## 0.3776
## 0.0283
## 0.1654
##
## lag = X4, movName = Corn:
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted -0.049732 0.0142 1802 -0.08388 -0.01559 -3.490
## Uninterrupted - Jumbled -0.011733 0.0144 1802 -0.04615 0.02268 -0.817
## Interrupted - Jumbled 0.037999 0.0142 1802 0.00385 0.07214 2.667
## p.value
## 0.0015
## 0.4141
## 0.0155
##
## lag = X5, movName = Corn:
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted -0.014608 0.0142 1802 -0.04875 0.01954 -1.025
## Uninterrupted - Jumbled -0.005243 0.0144 1802 -0.03966 0.02917 -0.365
## Interrupted - Jumbled 0.009365 0.0142 1802 -0.02478 0.04351 0.657
## p.value
## 0.9163
## 1.0000
## 1.0000
##
## Degrees-of-freedom method: kenward-roger
## Confidence level used: 0.95
## Conf-level adjustment: bonferroni method for 3 estimates
## P value adjustment: holm method for 3 tests
emm_options(lmerTest.limit = 3720)
lag.pairwise.emm <- emmeans(esKnow2.lagCRP.lagDiff.lmer, "condition", by = c("lag"), contr = "pairwise", weights = "proportional", adjust = "holm")
confint(lag.pairwise.emm, adjust = "holm", level = .95)
## $emmeans
## lag = X.5:
## condition emmean SE df lower.CL upper.CL
## Uninterrupted 0.01170 0.00735 1639 -5.91e-03 0.0293
## Interrupted 0.00798 0.00717 1633 -9.21e-03 0.0252
## Jumbled 0.01570 0.00729 1633 -1.77e-03 0.0332
##
## lag = X.4:
## condition emmean SE df lower.CL upper.CL
## Uninterrupted 0.01067 0.00735 1639 -6.94e-03 0.0283
## Interrupted 0.01883 0.00717 1633 1.64e-03 0.0360
## Jumbled 0.01168 0.00729 1633 -5.79e-03 0.0292
##
## lag = X.3:
## condition emmean SE df lower.CL upper.CL
## Uninterrupted 0.00534 0.00735 1639 -1.23e-02 0.0230
## Interrupted 0.00678 0.00717 1633 -1.04e-02 0.0240
## Jumbled 0.00982 0.00729 1633 -7.65e-03 0.0273
##
## lag = X.2:
## condition emmean SE df lower.CL upper.CL
## Uninterrupted 0.01118 0.00735 1639 -6.43e-03 0.0288
## Interrupted 0.01800 0.00717 1633 8.09e-04 0.0352
## Jumbled 0.01741 0.00729 1633 -6.14e-05 0.0349
##
## lag = X.1:
## condition emmean SE df lower.CL upper.CL
## Uninterrupted 0.00698 0.00735 1639 -1.06e-02 0.0246
## Interrupted 0.02210 0.00717 1633 4.90e-03 0.0393
## Jumbled 0.04344 0.00729 1633 2.60e-02 0.0609
##
## lag = X1:
## condition emmean SE df lower.CL upper.CL
## Uninterrupted 0.09392 0.00735 1639 7.63e-02 0.1115
## Interrupted 0.14131 0.00717 1633 1.24e-01 0.1585
## Jumbled 0.08533 0.00729 1633 6.79e-02 0.1028
##
## lag = X2:
## condition emmean SE df lower.CL upper.CL
## Uninterrupted 0.05414 0.00735 1639 3.65e-02 0.0717
## Interrupted 0.05663 0.00717 1633 3.94e-02 0.0738
## Jumbled 0.03769 0.00729 1633 2.02e-02 0.0552
##
## lag = X3:
## condition emmean SE df lower.CL upper.CL
## Uninterrupted 0.05311 0.00735 1639 3.55e-02 0.0707
## Interrupted 0.03859 0.00717 1633 2.14e-02 0.0558
## Jumbled 0.01310 0.00729 1633 -4.37e-03 0.0306
##
## lag = X4:
## condition emmean SE df lower.CL upper.CL
## Uninterrupted 0.05411 0.00735 1639 3.65e-02 0.0717
## Interrupted 0.06995 0.00717 1633 5.28e-02 0.0871
## Jumbled 0.03625 0.00729 1633 1.88e-02 0.0537
##
## lag = X5:
## condition emmean SE df lower.CL upper.CL
## Uninterrupted 0.03950 0.00735 1639 2.19e-02 0.0571
## Interrupted 0.03535 0.00717 1633 1.82e-02 0.0525
## Jumbled 0.02129 0.00729 1633 3.82e-03 0.0388
##
## Results are averaged over the levels of: movName
## Degrees-of-freedom method: kenward-roger
## Confidence level used: 0.95
## Conf-level adjustment: bonferroni method for 3 estimates
##
## $contrasts
## lag = X.5:
## contrast estimate SE df lower.CL upper.CL
## Uninterrupted - Interrupted 0.003723 0.0103 1636 -0.020888 0.02833
## Uninterrupted - Jumbled -0.003998 0.0104 1636 -0.028802 0.02081
## Interrupted - Jumbled -0.007721 0.0102 1633 -0.032231 0.01679
##
## lag = X.4:
## contrast estimate SE df lower.CL upper.CL
## Uninterrupted - Interrupted -0.008161 0.0103 1636 -0.032772 0.01645
## Uninterrupted - Jumbled -0.001011 0.0104 1636 -0.025815 0.02379
## Interrupted - Jumbled 0.007150 0.0102 1633 -0.017361 0.03166
##
## lag = X.3:
## contrast estimate SE df lower.CL upper.CL
## Uninterrupted - Interrupted -0.001441 0.0103 1636 -0.026052 0.02317
## Uninterrupted - Jumbled -0.004475 0.0104 1636 -0.029279 0.02033
## Interrupted - Jumbled -0.003034 0.0102 1633 -0.027545 0.02148
##
## lag = X.2:
## contrast estimate SE df lower.CL upper.CL
## Uninterrupted - Interrupted -0.006826 0.0103 1636 -0.031437 0.01778
## Uninterrupted - Jumbled -0.006230 0.0104 1636 -0.031034 0.01857
## Interrupted - Jumbled 0.000596 0.0102 1633 -0.023915 0.02511
##
## lag = X.1:
## contrast estimate SE df lower.CL upper.CL
## Uninterrupted - Interrupted -0.015122 0.0103 1636 -0.039733 0.00949
## Uninterrupted - Jumbled -0.036464 0.0104 1636 -0.061268 -0.01166
## Interrupted - Jumbled -0.021341 0.0102 1633 -0.045852 0.00317
##
## lag = X1:
## contrast estimate SE df lower.CL upper.CL
## Uninterrupted - Interrupted -0.047388 0.0103 1636 -0.071999 -0.02278
## Uninterrupted - Jumbled 0.008590 0.0104 1636 -0.016214 0.03339
## Interrupted - Jumbled 0.055978 0.0102 1633 0.031467 0.08049
##
## lag = X2:
## contrast estimate SE df lower.CL upper.CL
## Uninterrupted - Interrupted -0.002495 0.0103 1636 -0.027106 0.02212
## Uninterrupted - Jumbled 0.016447 0.0104 1636 -0.008357 0.04125
## Interrupted - Jumbled 0.018942 0.0102 1633 -0.005569 0.04345
##
## lag = X3:
## contrast estimate SE df lower.CL upper.CL
## Uninterrupted - Interrupted 0.014522 0.0103 1636 -0.010089 0.03913
## Uninterrupted - Jumbled 0.040018 0.0104 1636 0.015214 0.06482
## Interrupted - Jumbled 0.025497 0.0102 1633 0.000986 0.05001
##
## lag = X4:
## contrast estimate SE df lower.CL upper.CL
## Uninterrupted - Interrupted -0.015849 0.0103 1636 -0.040460 0.00876
## Uninterrupted - Jumbled 0.017860 0.0104 1636 -0.006944 0.04266
## Interrupted - Jumbled 0.033709 0.0102 1633 0.009198 0.05822
##
## lag = X5:
## contrast estimate SE df lower.CL upper.CL
## Uninterrupted - Interrupted 0.004142 0.0103 1636 -0.020469 0.02875
## Uninterrupted - Jumbled 0.018212 0.0104 1636 -0.006593 0.04302
## Interrupted - Jumbled 0.014069 0.0102 1633 -0.010442 0.03858
##
## Results are averaged over the levels of: movName
## Degrees-of-freedom method: kenward-roger
## Confidence level used: 0.95
## Conf-level adjustment: bonferroni method for 3 estimates
summary(lag.pairwise.emm$contrasts, infer = TRUE)
## lag = X.5:
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted 0.003723 0.0103 1636 -0.020888 0.02833 0.363
## Uninterrupted - Jumbled -0.003998 0.0104 1636 -0.028802 0.02081 -0.386
## Interrupted - Jumbled -0.007721 0.0102 1633 -0.032231 0.01679 -0.755
## p.value
## 1.0000
## 1.0000
## 1.0000
##
## lag = X.4:
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted -0.008161 0.0103 1636 -0.032772 0.01645 -0.795
## Uninterrupted - Jumbled -0.001011 0.0104 1636 -0.025815 0.02379 -0.098
## Interrupted - Jumbled 0.007150 0.0102 1633 -0.017361 0.03166 0.699
## p.value
## 1.0000
## 1.0000
## 1.0000
##
## lag = X.3:
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted -0.001441 0.0103 1636 -0.026052 0.02317 -0.140
## Uninterrupted - Jumbled -0.004475 0.0104 1636 -0.029279 0.02033 -0.432
## Interrupted - Jumbled -0.003034 0.0102 1633 -0.027545 0.02148 -0.297
## p.value
## 1.0000
## 1.0000
## 1.0000
##
## lag = X.2:
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted -0.006826 0.0103 1636 -0.031437 0.01778 -0.665
## Uninterrupted - Jumbled -0.006230 0.0104 1636 -0.031034 0.01857 -0.602
## Interrupted - Jumbled 0.000596 0.0102 1633 -0.023915 0.02511 0.058
## p.value
## 1.0000
## 1.0000
## 1.0000
##
## lag = X.1:
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted -0.015122 0.0103 1636 -0.039733 0.00949 -1.472
## Uninterrupted - Jumbled -0.036464 0.0104 1636 -0.061268 -0.01166 -3.523
## Interrupted - Jumbled -0.021341 0.0102 1633 -0.045852 0.00317 -2.087
## p.value
## 0.1411
## 0.0013
## 0.0742
##
## lag = X1:
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted -0.047388 0.0103 1636 -0.071999 -0.02278 -4.614
## Uninterrupted - Jumbled 0.008590 0.0104 1636 -0.016214 0.03339 0.830
## Interrupted - Jumbled 0.055978 0.0102 1633 0.031467 0.08049 5.473
## p.value
## <.0001
## 0.4067
## <.0001
##
## lag = X2:
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted -0.002495 0.0103 1636 -0.027106 0.02212 -0.243
## Uninterrupted - Jumbled 0.016447 0.0104 1636 -0.008357 0.04125 1.589
## Interrupted - Jumbled 0.018942 0.0102 1633 -0.005569 0.04345 1.852
## p.value
## 0.8081
## 0.2245
## 0.1926
##
## lag = X3:
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted 0.014522 0.0103 1636 -0.010089 0.03913 1.414
## Uninterrupted - Jumbled 0.040018 0.0104 1636 0.015214 0.06482 3.866
## Interrupted - Jumbled 0.025497 0.0102 1633 0.000986 0.05001 2.493
## p.value
## 0.1576
## 0.0003
## 0.0255
##
## lag = X4:
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted -0.015849 0.0103 1636 -0.040460 0.00876 -1.543
## Uninterrupted - Jumbled 0.017860 0.0104 1636 -0.006944 0.04266 1.726
## Interrupted - Jumbled 0.033709 0.0102 1633 0.009198 0.05822 3.296
## p.value
## 0.1692
## 0.1692
## 0.0030
##
## lag = X5:
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted 0.004142 0.0103 1636 -0.020469 0.02875 0.403
## Uninterrupted - Jumbled 0.018212 0.0104 1636 -0.006593 0.04302 1.760
## Interrupted - Jumbled 0.014069 0.0102 1633 -0.010442 0.03858 1.376
## p.value
## 0.6867
## 0.2360
## 0.3383
##
## Results are averaged over the levels of: movName
## Degrees-of-freedom method: kenward-roger
## Confidence level used: 0.95
## Conf-level adjustment: bonferroni method for 3 estimates
## P value adjustment: holm method for 3 tests
summary(emmeans(esKnow2.lagCRP.lagDiff.lmer.B, "condition", by = c("lag"), contr = "pairwise", weights = "proportional", adjust = "holm")$contrasts, infer = TRUE)
## lag = X.5:
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted 0.003701 0.0102 1611 -0.02073 0.02813 0.363
## Uninterrupted - Jumbled -0.004034 0.0103 1611 -0.02866 0.02059 -0.393
## Interrupted - Jumbled -0.007735 0.0102 1608 -0.03207 0.01660 -0.762
## p.value
## 1.0000
## 1.0000
## 1.0000
##
## lag = X.4:
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted -0.008120 0.0102 1611 -0.03255 0.01631 -0.796
## Uninterrupted - Jumbled -0.000994 0.0103 1611 -0.02562 0.02363 -0.097
## Interrupted - Jumbled 0.007126 0.0102 1608 -0.01721 0.03146 0.702
## p.value
## 1.0000
## 1.0000
## 1.0000
##
## lag = X.3:
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted -0.001408 0.0102 1611 -0.02584 0.02302 -0.138
## Uninterrupted - Jumbled -0.004457 0.0103 1611 -0.02908 0.02017 -0.434
## Interrupted - Jumbled -0.003049 0.0102 1608 -0.02738 0.02128 -0.300
## p.value
## 1.0000
## 1.0000
## 1.0000
##
## lag = X.2:
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted -0.006818 0.0102 1611 -0.03125 0.01761 -0.669
## Uninterrupted - Jumbled -0.006233 0.0103 1611 -0.03086 0.01839 -0.607
## Interrupted - Jumbled 0.000585 0.0102 1608 -0.02375 0.02492 0.058
## p.value
## 1.0000
## 1.0000
## 1.0000
##
## lag = X.1:
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted -0.015083 0.0102 1611 -0.03952 0.00935 -1.479
## Uninterrupted - Jumbled -0.036318 0.0103 1611 -0.06094 -0.01169 -3.535
## Interrupted - Jumbled -0.021235 0.0102 1608 -0.04557 0.00310 -2.091
## p.value
## 0.1392
## 0.0013
## 0.0733
##
## lag = X1:
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted -0.047150 0.0102 1611 -0.07158 -0.02272 -4.625
## Uninterrupted - Jumbled 0.008927 0.0103 1611 -0.01570 0.03355 0.869
## Interrupted - Jumbled 0.056077 0.0102 1608 0.03174 0.08041 5.523
## p.value
## <.0001
## 0.3851
## <.0001
##
## lag = X2:
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted -0.002684 0.0102 1611 -0.02712 0.02175 -0.263
## Uninterrupted - Jumbled 0.016282 0.0103 1611 -0.00834 0.04091 1.585
## Interrupted - Jumbled 0.018966 0.0102 1608 -0.00537 0.04330 1.868
## p.value
## 0.7924
## 0.2265
## 0.1859
##
## lag = X3:
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted 0.014508 0.0102 1611 -0.00992 0.03894 1.423
## Uninterrupted - Jumbled 0.040001 0.0103 1611 0.01538 0.06462 3.893
## Interrupted - Jumbled 0.025493 0.0102 1608 0.00116 0.04983 2.511
## p.value
## 0.1549
## 0.0003
## 0.0243
##
## lag = X4:
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted -0.015808 0.0102 1611 -0.04024 0.00862 -1.550
## Uninterrupted - Jumbled 0.017924 0.0103 1611 -0.00670 0.04255 1.744
## Interrupted - Jumbled 0.033732 0.0102 1608 0.00940 0.05806 3.322
## p.value
## 0.1625
## 0.1625
## 0.0027
##
## lag = X5:
## contrast estimate SE df lower.CL upper.CL t.ratio
## Uninterrupted - Interrupted 0.004326 0.0102 1611 -0.02011 0.02876 0.424
## Uninterrupted - Jumbled 0.018370 0.0103 1611 -0.00625 0.04299 1.788
## Interrupted - Jumbled 0.014044 0.0102 1608 -0.01029 0.03838 1.383
## p.value
## 0.6714
## 0.2220
## 0.3336
##
## Results are averaged over the levels of: movName
## Degrees-of-freedom method: kenward-roger
## Confidence level used: 0.95
## Conf-level adjustment: bonferroni method for 3 estimates
## P value adjustment: holm method for 3 tests
Jumbled condition have a stronger tendency for -1 recall transition compared to both uninterrupted and interrupted conditions. There is no effect of condition on probability +1 recall transition. Jumbled condition have a stronger tendency for -1 recall transition compared to both uninterrupted and interrupted conditions. There is no effect of condition on probability +1 recall transition.
esKnow2.lagCRP_plot <- esKnow2.lagCRP_long %>% dplyr::group_by(lag, condition, movName) %>% dplyr::summarise(mean.prob = mean(prob), se.prob = sd(prob)/sqrt(n()), n.prob = n()) %>% dplyr::mutate(
lower.ci.prob = mean.prob - qt(1 - (0.05 / 2), n.prob - 1) * se.prob,
upper.ci.prob = mean.prob + qt(1 - (0.05 / 2), n.prob - 1) * se.prob)
esKnow2_lagCRP_plot <- ggplot(esKnow2.lagCRP_plot, aes(x = lag, y = mean.prob, group = condition, color = condition))+
#geom_ribbon(stat = "summary", fun = )
geom_ribbon(aes(ymin = mean.prob - lower.ci.prob, ymax = mean.prob + upper.ci.prob, fill = condition), alpha = 0.3, color=NA)+
geom_line(size = 1.5)+
geom_point( alpha = 1.2, shape = 21, size = point.size-1, stroke = 1.5, show.legend = FALSE, aes(fill = condition))+
#stat_summary(geom = "errorbar", fun.data = "mean_se", width = 0.2, alpha = 1, size = 0.7)+
scale_fill_manual(values = colors$point.colors[4:6], labels = c('U', 'I', 'J'))+
scale_color_manual(values = colors$point.colors, labels= c('U', 'I', 'J'))+
scale_x_discrete(lim = lags_to_plot,
labels = c('-5', '-4', '-3', '-2', '-1', '0', '1', '2', '3', '4', '5'))+
coord_cartesian(ylim = c(0,0.4))+
facet_wrap(~movName)+
#annotate("text", x = 5, y = .35, label = "*", color = outline.color, size = 8, fontface = txt.face) +
#annotate("text", x = 7, y = .35, label = "***", color = outline.color, size = 8, fontface = txt.face) +
#annotate("text", x = 8, y = .35, label = "*", color = outline.color, size = 8, fontface = txt.face) +
#annotate("text", x = 9, y = .35, label = "**", color = outline.color, size = 8, fontface = txt.face) +
#annotate("text", x = 10, y = .35, label = "***", color = outline.color, size = 8, fontface = txt.face) +
#ylim(0, 0.2)+
labs(y = "Conditional probability", x = "Lag")+
theme(legend.position = "none")+
theme.esKnow
esKnow2_lagCRP_plot
There is no difference in pattern of forward recall for all conditions. Jumbled participants have steeper backwards recall curve pattern compared to other conditions.
##Create figure for recall results from esKnow2 (Figure S5)
figS7_top <- ggarrange(esKnow2.recallRate_plot, esKnow2.recallTime_plot,
labels = c("A", "B"),
ncol = 2, nrow = 1)
figs7_middle <- ggarrange(esKnow2.semanticClustering_plot, esKnow2.temporalClustering_plot,
labels = c("C", "D"),
widths = c(1, 2),
ncol = 2, nrow = 1)
figureS7 <- ggarrange(figS7_top, figs7_middle, esKnow2_lagCRP_plot,
labels = c("", "", "E"),
ncol = 1, nrow = 3)
figureS7
setwd('../plots/')
ggsave("esKnow2_figureS7.pdf", plot = figureS7, width = 9, height = 11, device = cairo_pdf)
pdf_convert(pdf = "esKnow2_figureS7.pdf", format = "png", dpi = 300,
filenames = "esKnow2_figureS7.png")
## Converting page 1 to esKnow2_figureS7.png... done!
## [1] "esKnow2_figureS7.png"
Jumbled participants have higher recall precision compared to pariticipants in the interrupted and uninterrupted conditions. This may mean higher level of details are included in Jumbled participants’ recall (perhaps increase in response associated with perceptual transient changes during segmentation task result in higher retention of perceptual details).
Disrupting information flow to a greater extent (every 5 seconds) further impairs segmentation, particularly when information cannot be accummulated coherently over time. Participants in the jumbled conditions seem to rely on localized, transient perceptual changes for segmentation and less likely to be segmentation based on movie content. This disruption in information flow also further impairs memory. Although participants in esKnow2 recalled similar overall number of events, the temporal organization of events for Jumbled pariticipants’ are severly affected. Overall, just interrupted information flow (Interrupted conditioins) seem to have minimal influence on segmentation and event memory.
Overall, this set of findings provide evidence for dissociation between how information are processed for segmentation and formation of event memory and organization. While segmentation realies on information accumulated over short timescales, formation and organization of event memories require accummulation of coherent information over longer timescales.